Merge branch 'rb/compat-poll-fix' into maint
[git] / git-gui / lib / commit.tcl
1 # git-gui misc. commit reading/writing support
2 # Copyright (C) 2006, 2007 Shawn Pearce
3
4 proc load_last_commit {} {
5         global HEAD PARENT MERGE_HEAD commit_type ui_comm commit_author
6         global repo_config
7
8         if {[llength $PARENT] == 0} {
9                 error_popup [mc "There is nothing to amend.
10
11 You are about to create the initial commit.  There is no commit before this to amend.
12 "]
13                 return
14         }
15
16         repository_state curType curHEAD curMERGE_HEAD
17         if {$curType eq {merge}} {
18                 error_popup [mc "Cannot amend while merging.
19
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.
21 "]
22                 return
23         }
24
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]]
37                                 } elseif {[regexp "author (.*)\\s<(.*)>\\s(\\d.*$)" $line all name email time]} {
38                                         set commit_author [list name $name email $email date $time]
39                                 }
40                         }
41                         set msg [read $fd]
42                         close $fd
43
44                         set enc [tcl_encoding $enc]
45                         if {$enc ne {}} {
46                                 set msg [encoding convertfrom $enc $msg]
47                         }
48                         set msg [string trim $msg]
49                 } err]} {
50                 error_popup [strcat [mc "Error loading commit data for amend:"] "\n\n$err"]
51                 return
52         }
53
54         set HEAD $curHEAD
55         set PARENT $parents
56         set MERGE_HEAD [list]
57         switch -- [llength $parents] {
58         0       {set commit_type amend-initial}
59         1       {set commit_type amend}
60         default {set commit_type amend-merge}
61         }
62
63         $ui_comm delete 0.0 end
64         $ui_comm insert end $msg
65         $ui_comm edit reset
66         $ui_comm edit modified false
67         rescan ui_ready
68 }
69
70 set GIT_COMMITTER_IDENT {}
71
72 proc committer_ident {} {
73         global GIT_COMMITTER_IDENT
74
75         if {$GIT_COMMITTER_IDENT eq {}} {
76                 if {[catch {set me [git var GIT_COMMITTER_IDENT]} err]} {
77                         error_popup [strcat [mc "Unable to obtain your identity:"] "\n\n$err"]
78                         return {}
79                 }
80                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
81                         $me me GIT_COMMITTER_IDENT]} {
82                         error_popup [strcat [mc "Invalid GIT_COMMITTER_IDENT:"] "\n\n$me"]
83                         return {}
84                 }
85         }
86
87         return $GIT_COMMITTER_IDENT
88 }
89
90 proc do_signoff {} {
91         global ui_comm
92
93         set me [committer_ident]
94         if {$me eq {}} return
95
96         set sob "Signed-off-by: $me"
97         set last [$ui_comm get {end -1c linestart} {end -1c}]
98         if {$last ne $sob} {
99                 $ui_comm edit separator
100                 if {$last ne {}
101                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
102                         $ui_comm insert end "\n"
103                 }
104                 $ui_comm insert end "\n$sob"
105                 $ui_comm edit separator
106                 $ui_comm see end
107         }
108 }
109
110 proc create_new_commit {} {
111         global commit_type ui_comm commit_author
112
113         set commit_type normal
114         unset -nocomplain commit_author
115         $ui_comm delete 0.0 end
116         $ui_comm edit reset
117         $ui_comm edit modified false
118         rescan ui_ready
119 }
120
121 proc setup_commit_encoding {msg_wt {quiet 0}} {
122         global repo_config
123
124         if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
125                 set enc utf-8
126         }
127         set use_enc [tcl_encoding $enc]
128         if {$use_enc ne {}} {
129                 fconfigure $msg_wt -encoding $use_enc
130         } else {
131                 if {!$quiet} {
132                         error_popup [mc "warning: Tcl does not support encoding '%s'." $enc]
133                 }
134                 fconfigure $msg_wt -encoding utf-8
135         }
136 }
137
138 proc commit_tree {} {
139         global HEAD commit_type file_states ui_comm repo_config
140         global pch_error
141
142         if {[committer_ident] eq {}} return
143         if {![lock_index update]} return
144
145         # -- Our in memory state should match the repository.
146         #
147         repository_state curType curHEAD curMERGE_HEAD
148         if {[string match amend* $commit_type]
149                 && $curType eq {normal}
150                 && $curHEAD eq $HEAD} {
151         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
152                 info_popup [mc "Last scanned state does not match repository state.
153
154 Another Git program has modified this repository since the last scan.  A rescan must be performed before another commit can be created.
155
156 The rescan will be automatically started now.
157 "]
158                 unlock_index
159                 rescan ui_ready
160                 return
161         }
162
163         # -- At least one file should differ in the index.
164         #
165         set files_ready 0
166         foreach path [array names file_states] {
167                 set s $file_states($path)
168                 switch -glob -- [lindex $s 0] {
169                 _? {continue}
170                 A? -
171                 D? -
172                 T? -
173                 M? {set files_ready 1}
174                 _U -
175                 U? {
176                         error_popup [mc "Unmerged files cannot be committed.
177
178 File %s has merge conflicts.  You must resolve them and stage the file before committing.
179 " [short_path $path]]
180                         unlock_index
181                         return
182                 }
183                 default {
184                         error_popup [mc "Unknown file state %s detected.
185
186 File %s cannot be committed by this program.
187 " [lindex $s 0] [short_path $path]]
188                 }
189                 }
190         }
191         if {!$files_ready && ![string match *merge $curType] && ![is_enabled nocommit]} {
192                 info_popup [mc "No changes to commit.
193
194 You must stage at least 1 file before you can commit.
195 "]
196                 unlock_index
197                 return
198         }
199
200         if {[is_enabled nocommitmsg]} { do_quit 0 }
201
202         # -- A message is required.
203         #
204         set msg [string trim [$ui_comm get 1.0 end]]
205         regsub -all -line {[ \t\r]+$} $msg {} msg
206         if {$msg eq {}} {
207                 error_popup [mc "Please supply a commit message.
208
209 A good commit message has the following format:
210
211 - First line: Describe in one sentence what you did.
212 - Second line: Blank
213 - Remaining lines: Describe why this change is good.
214 "]
215                 unlock_index
216                 return
217         }
218
219         # -- Build the message file.
220         #
221         set msg_p [gitdir GITGUI_EDITMSG]
222         set msg_wt [open $msg_p w]
223         fconfigure $msg_wt -translation lf
224         setup_commit_encoding $msg_wt
225         puts $msg_wt $msg
226         close $msg_wt
227
228         if {[is_enabled nocommit]} { do_quit 0 }
229
230         # -- Run the pre-commit hook.
231         #
232         set fd_ph [githook_read pre-commit]
233         if {$fd_ph eq {}} {
234                 commit_commitmsg $curHEAD $msg_p
235                 return
236         }
237
238         ui_status [mc "Calling pre-commit hook..."]
239         set pch_error {}
240         fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
241         fileevent $fd_ph readable \
242                 [list commit_prehook_wait $fd_ph $curHEAD $msg_p]
243 }
244
245 proc commit_prehook_wait {fd_ph curHEAD msg_p} {
246         global pch_error
247
248         append pch_error [read $fd_ph]
249         fconfigure $fd_ph -blocking 1
250         if {[eof $fd_ph]} {
251                 if {[catch {close $fd_ph}]} {
252                         catch {file delete $msg_p}
253                         ui_status [mc "Commit declined by pre-commit hook."]
254                         hook_failed_popup pre-commit $pch_error
255                         unlock_index
256                 } else {
257                         commit_commitmsg $curHEAD $msg_p
258                 }
259                 set pch_error {}
260                 return
261         }
262         fconfigure $fd_ph -blocking 0
263 }
264
265 proc commit_commitmsg {curHEAD msg_p} {
266         global is_detached repo_config
267         global pch_error
268
269         if {$is_detached
270             && ![file exists [gitdir rebase-merge head-name]]
271             &&  [is_config_true gui.warndetachedcommit]} {
272                 set msg [mc "You are about to commit on a detached head.\
273 This is a potentially dangerous thing to do because if you switch\
274 to another branch you will lose your changes and it can be difficult\
275 to retrieve them later from the reflog. You should probably cancel this\
276 commit and create a new branch to continue.\n\
277 \n\
278 Do you really want to proceed with your Commit?"]
279                 if {[ask_popup $msg] ne yes} {
280                         unlock_index
281                         return
282                 }
283         }
284
285         # -- Run the commit-msg hook.
286         #
287         set fd_ph [githook_read commit-msg $msg_p]
288         if {$fd_ph eq {}} {
289                 commit_writetree $curHEAD $msg_p
290                 return
291         }
292
293         ui_status [mc "Calling commit-msg hook..."]
294         set pch_error {}
295         fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
296         fileevent $fd_ph readable \
297                 [list commit_commitmsg_wait $fd_ph $curHEAD $msg_p]
298 }
299
300 proc commit_commitmsg_wait {fd_ph curHEAD msg_p} {
301         global pch_error
302
303         append pch_error [read $fd_ph]
304         fconfigure $fd_ph -blocking 1
305         if {[eof $fd_ph]} {
306                 if {[catch {close $fd_ph}]} {
307                         catch {file delete $msg_p}
308                         ui_status [mc "Commit declined by commit-msg hook."]
309                         hook_failed_popup commit-msg $pch_error
310                         unlock_index
311                 } else {
312                         commit_writetree $curHEAD $msg_p
313                 }
314                 set pch_error {}
315                 return
316         }
317         fconfigure $fd_ph -blocking 0
318 }
319
320 proc commit_writetree {curHEAD msg_p} {
321         ui_status [mc "Committing changes..."]
322         set fd_wt [git_read write-tree]
323         fileevent $fd_wt readable \
324                 [list commit_committree $fd_wt $curHEAD $msg_p]
325 }
326
327 proc commit_committree {fd_wt curHEAD msg_p} {
328         global HEAD PARENT MERGE_HEAD commit_type commit_author
329         global current_branch
330         global ui_comm selected_commit_type
331         global file_states selected_paths rescan_active
332         global repo_config
333         global env
334
335         gets $fd_wt tree_id
336         if {[catch {close $fd_wt} err]} {
337                 catch {file delete $msg_p}
338                 error_popup [strcat [mc "write-tree failed:"] "\n\n$err"]
339                 ui_status [mc "Commit failed."]
340                 unlock_index
341                 return
342         }
343
344         # -- Verify this wasn't an empty change.
345         #
346         if {$commit_type eq {normal}} {
347                 set fd_ot [git_read cat-file commit $PARENT]
348                 fconfigure $fd_ot -encoding binary -translation lf
349                 set old_tree [gets $fd_ot]
350                 close $fd_ot
351
352                 if {[string equal -length 5 {tree } $old_tree]
353                         && [string length $old_tree] == 45} {
354                         set old_tree [string range $old_tree 5 end]
355                 } else {
356                         error [mc "Commit %s appears to be corrupt" $PARENT]
357                 }
358
359                 if {$tree_id eq $old_tree} {
360                         catch {file delete $msg_p}
361                         info_popup [mc "No changes to commit.
362
363 No files were modified by this commit and it was not a merge commit.
364
365 A rescan will be automatically started now.
366 "]
367                         unlock_index
368                         rescan {ui_status [mc "No changes to commit."]}
369                         return
370                 }
371         }
372
373         if {[info exists commit_author]} {
374                 set old_author [commit_author_ident $commit_author]
375         }
376         # -- Create the commit.
377         #
378         set cmd [list commit-tree $tree_id]
379         if {[is_config_true commit.gpgsign]} {
380                 lappend cmd -S
381         }
382         foreach p [concat $PARENT $MERGE_HEAD] {
383                 lappend cmd -p $p
384         }
385         lappend cmd <$msg_p
386         if {[catch {set cmt_id [eval git $cmd]} err]} {
387                 catch {file delete $msg_p}
388                 error_popup [strcat [mc "commit-tree failed:"] "\n\n$err"]
389                 ui_status [mc "Commit failed."]
390                 unlock_index
391                 unset -nocomplain commit_author
392                 commit_author_reset $old_author
393                 return
394         }
395         if {[info exists commit_author]} {
396                 unset -nocomplain commit_author
397                 commit_author_reset $old_author
398         }
399
400         # -- Update the HEAD ref.
401         #
402         set reflogm commit
403         if {$commit_type ne {normal}} {
404                 append reflogm " ($commit_type)"
405         }
406         set msg_fd [open $msg_p r]
407         setup_commit_encoding $msg_fd 1
408         gets $msg_fd subject
409         close $msg_fd
410         append reflogm {: } $subject
411         if {[catch {
412                         git update-ref -m $reflogm HEAD $cmt_id $curHEAD
413                 } err]} {
414                 catch {file delete $msg_p}
415                 error_popup [strcat [mc "update-ref failed:"] "\n\n$err"]
416                 ui_status [mc "Commit failed."]
417                 unlock_index
418                 return
419         }
420
421         # -- Cleanup after ourselves.
422         #
423         catch {file delete $msg_p}
424         catch {file delete [gitdir MERGE_HEAD]}
425         catch {file delete [gitdir MERGE_MSG]}
426         catch {file delete [gitdir SQUASH_MSG]}
427         catch {file delete [gitdir GITGUI_MSG]}
428         catch {file delete [gitdir CHERRY_PICK_HEAD]}
429
430         # -- Let rerere do its thing.
431         #
432         if {[get_config rerere.enabled] eq {}} {
433                 set rerere [file isdirectory [gitdir rr-cache]]
434         } else {
435                 set rerere [is_config_true rerere.enabled]
436         }
437         if {$rerere} {
438                 catch {git rerere}
439         }
440
441         # -- Run the post-commit hook.
442         #
443         set fd_ph [githook_read post-commit]
444         if {$fd_ph ne {}} {
445                 global pch_error
446                 set pch_error {}
447                 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
448                 fileevent $fd_ph readable \
449                         [list commit_postcommit_wait $fd_ph $cmt_id]
450         }
451
452         $ui_comm delete 0.0 end
453         $ui_comm edit reset
454         $ui_comm edit modified false
455         if {$::GITGUI_BCK_exists} {
456                 catch {file delete [gitdir GITGUI_BCK]}
457                 set ::GITGUI_BCK_exists 0
458         }
459
460         if {[is_enabled singlecommit]} { do_quit 0 }
461
462         # -- Update in memory status
463         #
464         set selected_commit_type new
465         set commit_type normal
466         set HEAD $cmt_id
467         set PARENT $cmt_id
468         set MERGE_HEAD [list]
469
470         foreach path [array names file_states] {
471                 set s $file_states($path)
472                 set m [lindex $s 0]
473                 switch -glob -- $m {
474                 _O -
475                 _M -
476                 _D {continue}
477                 __ -
478                 A_ -
479                 M_ -
480                 T_ -
481                 D_ {
482                         unset file_states($path)
483                         catch {unset selected_paths($path)}
484                 }
485                 DO {
486                         set file_states($path) [list _O [lindex $s 1] {} {}]
487                 }
488                 AM -
489                 AD -
490                 AT -
491                 TM -
492                 TD -
493                 MM -
494                 MT -
495                 MD {
496                         set file_states($path) [list \
497                                 _[string index $m 1] \
498                                 [lindex $s 1] \
499                                 [lindex $s 3] \
500                                 {}]
501                 }
502                 }
503         }
504
505         display_all_files
506         unlock_index
507         reshow_diff
508         ui_status [mc "Created commit %s: %s" [string range $cmt_id 0 7] $subject]
509 }
510
511 proc commit_postcommit_wait {fd_ph cmt_id} {
512         global pch_error
513
514         append pch_error [read $fd_ph]
515         fconfigure $fd_ph -blocking 1
516         if {[eof $fd_ph]} {
517                 if {[catch {close $fd_ph}]} {
518                         hook_failed_popup post-commit $pch_error 0
519                 }
520                 unset pch_error
521                 return
522         }
523         fconfigure $fd_ph -blocking 0
524 }
525
526 proc commit_author_ident {details} {
527         global env
528         array set author $details
529         set old [array get env GIT_AUTHOR_*]
530         set env(GIT_AUTHOR_NAME) $author(name)
531         set env(GIT_AUTHOR_EMAIL) $author(email)
532         set env(GIT_AUTHOR_DATE) $author(date)
533         return $old
534 }
535 proc commit_author_reset {details} {
536         global env
537         unset env(GIT_AUTHOR_NAME) env(GIT_AUTHOR_EMAIL) env(GIT_AUTHOR_DATE)
538         if {$details ne {}} {
539                 array set env $details
540         }
541 }