git-svn: add fetch --parent option
[git/debian.git] / git-gui / lib / commit.tcl
blob9cc84105952d02f0171be0e23f0a82373bae0545
1 # git-gui misc. commit reading/writing support
2 # Copyright (C) 2006, 2007 Shawn Pearce
4 proc load_last_commit {} {
5 global HEAD PARENT MERGE_HEAD commit_type ui_comm
6 global repo_config
8 if {[llength $PARENT] == 0} {
9 error_popup [mc "There is nothing to amend.
11 You are about to create the initial commit. There is no commit before this to amend.
13 return
16 repository_state curType curHEAD curMERGE_HEAD
17 if {$curType eq {merge}} {
18 error_popup [mc "Cannot amend while merging.
20 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.
22 return
25 set msg {}
26 set parents [list]
27 if {[catch {
28 set fd [git_read cat-file commit $curHEAD]
29 fconfigure $fd -encoding binary -translation lf
30 # By default commits are assumed to be in utf-8
31 set enc utf-8
32 while {[gets $fd line] > 0} {
33 if {[string match {parent *} $line]} {
34 lappend parents [string range $line 7 end]
35 } elseif {[string match {encoding *} $line]} {
36 set enc [string tolower [string range $line 9 end]]
39 set msg [read $fd]
40 close $fd
42 set enc [tcl_encoding $enc]
43 if {$enc ne {}} {
44 set msg [encoding convertfrom $enc $msg]
46 set msg [string trim $msg]
47 } err]} {
48 error_popup [strcat [mc "Error loading commit data for amend:"] "\n\n$err"]
49 return
52 set HEAD $curHEAD
53 set PARENT $parents
54 set MERGE_HEAD [list]
55 switch -- [llength $parents] {
56 0 {set commit_type amend-initial}
57 1 {set commit_type amend}
58 default {set commit_type amend-merge}
61 $ui_comm delete 0.0 end
62 $ui_comm insert end $msg
63 $ui_comm edit reset
64 $ui_comm edit modified false
65 rescan ui_ready
68 set GIT_COMMITTER_IDENT {}
70 proc committer_ident {} {
71 global GIT_COMMITTER_IDENT
73 if {$GIT_COMMITTER_IDENT eq {}} {
74 if {[catch {set me [git var GIT_COMMITTER_IDENT]} err]} {
75 error_popup [strcat [mc "Unable to obtain your identity:"] "\n\n$err"]
76 return {}
78 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
79 $me me GIT_COMMITTER_IDENT]} {
80 error_popup [strcat [mc "Invalid GIT_COMMITTER_IDENT:"] "\n\n$me"]
81 return {}
85 return $GIT_COMMITTER_IDENT
88 proc do_signoff {} {
89 global ui_comm
91 set me [committer_ident]
92 if {$me eq {}} return
94 set sob "Signed-off-by: $me"
95 set last [$ui_comm get {end -1c linestart} {end -1c}]
96 if {$last ne $sob} {
97 $ui_comm edit separator
98 if {$last ne {}
99 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
100 $ui_comm insert end "\n"
102 $ui_comm insert end "\n$sob"
103 $ui_comm edit separator
104 $ui_comm see end
108 proc create_new_commit {} {
109 global commit_type ui_comm
111 set commit_type normal
112 $ui_comm delete 0.0 end
113 $ui_comm edit reset
114 $ui_comm edit modified false
115 rescan ui_ready
118 proc commit_tree {} {
119 global HEAD commit_type file_states ui_comm repo_config
120 global pch_error
122 if {[committer_ident] eq {}} return
123 if {![lock_index update]} return
125 # -- Our in memory state should match the repository.
127 repository_state curType curHEAD curMERGE_HEAD
128 if {[string match amend* $commit_type]
129 && $curType eq {normal}
130 && $curHEAD eq $HEAD} {
131 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
132 info_popup [mc "Last scanned state does not match repository state.
134 Another Git program has modified this repository since the last scan. A rescan must be performed before another commit can be created.
136 The rescan will be automatically started now.
138 unlock_index
139 rescan ui_ready
140 return
143 # -- At least one file should differ in the index.
145 set files_ready 0
146 foreach path [array names file_states] {
147 switch -glob -- [lindex $file_states($path) 0] {
148 _? {continue}
149 A? -
150 D? -
151 T_ -
152 M? {set files_ready 1}
153 _U -
154 U? {
155 error_popup [mc "Unmerged files cannot be committed.
157 File %s has merge conflicts. You must resolve them and stage the file before committing.
158 " [short_path $path]]
159 unlock_index
160 return
162 default {
163 error_popup [mc "Unknown file state %s detected.
165 File %s cannot be committed by this program.
166 " [lindex $s 0] [short_path $path]]
170 if {!$files_ready && ![string match *merge $curType] && ![is_enabled nocommit]} {
171 info_popup [mc "No changes to commit.
173 You must stage at least 1 file before you can commit.
175 unlock_index
176 return
179 if {[is_enabled nocommitmsg]} { do_quit 0 }
181 # -- A message is required.
183 set msg [string trim [$ui_comm get 1.0 end]]
184 regsub -all -line {[ \t\r]+$} $msg {} msg
185 if {$msg eq {}} {
186 error_popup [mc "Please supply a commit message.
188 A good commit message has the following format:
190 - First line: Describe in one sentence what you did.
191 - Second line: Blank
192 - Remaining lines: Describe why this change is good.
194 unlock_index
195 return
198 # -- Build the message file.
200 set msg_p [gitdir GITGUI_EDITMSG]
201 set msg_wt [open $msg_p w]
202 fconfigure $msg_wt -translation lf
203 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
204 set enc utf-8
206 set use_enc [tcl_encoding $enc]
207 if {$use_enc ne {}} {
208 fconfigure $msg_wt -encoding $use_enc
209 } else {
210 error_popup [mc "warning: Tcl does not support encoding '%s'." $enc]
211 fconfigure $msg_wt -encoding utf-8
213 puts $msg_wt $msg
214 close $msg_wt
216 if {[is_enabled nocommit]} { do_quit 0 }
218 # -- Run the pre-commit hook.
220 set fd_ph [githook_read pre-commit]
221 if {$fd_ph eq {}} {
222 commit_commitmsg $curHEAD $msg_p
223 return
226 ui_status [mc "Calling pre-commit hook..."]
227 set pch_error {}
228 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
229 fileevent $fd_ph readable \
230 [list commit_prehook_wait $fd_ph $curHEAD $msg_p]
233 proc commit_prehook_wait {fd_ph curHEAD msg_p} {
234 global pch_error
236 append pch_error [read $fd_ph]
237 fconfigure $fd_ph -blocking 1
238 if {[eof $fd_ph]} {
239 if {[catch {close $fd_ph}]} {
240 catch {file delete $msg_p}
241 ui_status [mc "Commit declined by pre-commit hook."]
242 hook_failed_popup pre-commit $pch_error
243 unlock_index
244 } else {
245 commit_commitmsg $curHEAD $msg_p
247 set pch_error {}
248 return
250 fconfigure $fd_ph -blocking 0
253 proc commit_commitmsg {curHEAD msg_p} {
254 global pch_error
256 # -- Run the commit-msg hook.
258 set fd_ph [githook_read commit-msg $msg_p]
259 if {$fd_ph eq {}} {
260 commit_writetree $curHEAD $msg_p
261 return
264 ui_status [mc "Calling commit-msg hook..."]
265 set pch_error {}
266 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
267 fileevent $fd_ph readable \
268 [list commit_commitmsg_wait $fd_ph $curHEAD $msg_p]
271 proc commit_commitmsg_wait {fd_ph curHEAD msg_p} {
272 global pch_error
274 append pch_error [read $fd_ph]
275 fconfigure $fd_ph -blocking 1
276 if {[eof $fd_ph]} {
277 if {[catch {close $fd_ph}]} {
278 catch {file delete $msg_p}
279 ui_status [mc "Commit declined by commit-msg hook."]
280 hook_failed_popup commit-msg $pch_error
281 unlock_index
282 } else {
283 commit_writetree $curHEAD $msg_p
285 set pch_error {}
286 return
288 fconfigure $fd_ph -blocking 0
291 proc commit_writetree {curHEAD msg_p} {
292 ui_status [mc "Committing changes..."]
293 set fd_wt [git_read write-tree]
294 fileevent $fd_wt readable \
295 [list commit_committree $fd_wt $curHEAD $msg_p]
298 proc commit_committree {fd_wt curHEAD msg_p} {
299 global HEAD PARENT MERGE_HEAD commit_type
300 global current_branch
301 global ui_comm selected_commit_type
302 global file_states selected_paths rescan_active
303 global repo_config
305 gets $fd_wt tree_id
306 if {[catch {close $fd_wt} err]} {
307 catch {file delete $msg_p}
308 error_popup [strcat [mc "write-tree failed:"] "\n\n$err"]
309 ui_status [mc "Commit failed."]
310 unlock_index
311 return
314 # -- Verify this wasn't an empty change.
316 if {$commit_type eq {normal}} {
317 set fd_ot [git_read cat-file commit $PARENT]
318 fconfigure $fd_ot -encoding binary -translation lf
319 set old_tree [gets $fd_ot]
320 close $fd_ot
322 if {[string equal -length 5 {tree } $old_tree]
323 && [string length $old_tree] == 45} {
324 set old_tree [string range $old_tree 5 end]
325 } else {
326 error [mc "Commit %s appears to be corrupt" $PARENT]
329 if {$tree_id eq $old_tree} {
330 catch {file delete $msg_p}
331 info_popup [mc "No changes to commit.
333 No files were modified by this commit and it was not a merge commit.
335 A rescan will be automatically started now.
337 unlock_index
338 rescan {ui_status [mc "No changes to commit."]}
339 return
343 # -- Create the commit.
345 set cmd [list commit-tree $tree_id]
346 foreach p [concat $PARENT $MERGE_HEAD] {
347 lappend cmd -p $p
349 lappend cmd <$msg_p
350 if {[catch {set cmt_id [eval git $cmd]} err]} {
351 catch {file delete $msg_p}
352 error_popup [strcat [mc "commit-tree failed:"] "\n\n$err"]
353 ui_status [mc "Commit failed."]
354 unlock_index
355 return
358 # -- Update the HEAD ref.
360 set reflogm commit
361 if {$commit_type ne {normal}} {
362 append reflogm " ($commit_type)"
364 set msg_fd [open $msg_p r]
365 gets $msg_fd subject
366 close $msg_fd
367 append reflogm {: } $subject
368 if {[catch {
369 git update-ref -m $reflogm HEAD $cmt_id $curHEAD
370 } err]} {
371 catch {file delete $msg_p}
372 error_popup [strcat [mc "update-ref failed:"] "\n\n$err"]
373 ui_status [mc "Commit failed."]
374 unlock_index
375 return
378 # -- Cleanup after ourselves.
380 catch {file delete $msg_p}
381 catch {file delete [gitdir MERGE_HEAD]}
382 catch {file delete [gitdir MERGE_MSG]}
383 catch {file delete [gitdir SQUASH_MSG]}
384 catch {file delete [gitdir GITGUI_MSG]}
386 # -- Let rerere do its thing.
388 if {[get_config rerere.enabled] eq {}} {
389 set rerere [file isdirectory [gitdir rr-cache]]
390 } else {
391 set rerere [is_config_true rerere.enabled]
393 if {$rerere} {
394 catch {git rerere}
397 # -- Run the post-commit hook.
399 set fd_ph [githook_read post-commit]
400 if {$fd_ph ne {}} {
401 upvar #0 pch_error$cmt_id pc_err
402 set pc_err {}
403 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
404 fileevent $fd_ph readable \
405 [list commit_postcommit_wait $fd_ph $cmt_id]
408 $ui_comm delete 0.0 end
409 $ui_comm edit reset
410 $ui_comm edit modified false
411 if {$::GITGUI_BCK_exists} {
412 catch {file delete [gitdir GITGUI_BCK]}
413 set ::GITGUI_BCK_exists 0
416 if {[is_enabled singlecommit]} { do_quit 0 }
418 # -- Update in memory status
420 set selected_commit_type new
421 set commit_type normal
422 set HEAD $cmt_id
423 set PARENT $cmt_id
424 set MERGE_HEAD [list]
426 foreach path [array names file_states] {
427 set s $file_states($path)
428 set m [lindex $s 0]
429 switch -glob -- $m {
430 _O -
431 _M -
432 _D {continue}
433 __ -
434 A_ -
435 M_ -
436 T_ -
437 D_ {
438 unset file_states($path)
439 catch {unset selected_paths($path)}
441 DO {
442 set file_states($path) [list _O [lindex $s 1] {} {}]
444 AM -
445 AD -
446 MM -
447 MD {
448 set file_states($path) [list \
449 _[string index $m 1] \
450 [lindex $s 1] \
451 [lindex $s 3] \
457 display_all_files
458 unlock_index
459 reshow_diff
460 ui_status [mc "Created commit %s: %s" [string range $cmt_id 0 7] $subject]
463 proc commit_postcommit_wait {fd_ph cmt_id} {
464 upvar #0 pch_error$cmt_id pch_error
466 append pch_error [read $fd_ph]
467 fconfigure $fd_ph -blocking 1
468 if {[eof $fd_ph]} {
469 if {[catch {close $fd_ph}]} {
470 hook_failed_popup post-commit $pch_error 0
472 unset pch_error
473 return
475 fconfigure $fd_ph -blocking 0