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