]> git.ipfire.org Git - thirdparty/git.git/blame - git-gui
git-gui: Correctly handle files containing LF in their name.
[thirdparty/git.git] / git-gui
CommitLineData
cb07fc2a
SP
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4
5# Copyright (C) 2006 Shawn Pearce, Paul Mackerras. All rights reserved.
6# This program is free software; it may be used, copied, modified
7# and distributed under the terms of the GNU General Public Licence,
8# either version 2, or (at your option) any later version.
9
2d19516d
SP
10######################################################################
11##
12## config
13
14proc load_repo_config {} {
15 global repo_config
16 global cfg_trust_mtime
17
18 array unset repo_config
19 catch {
20 set fd_rc [open "| git repo-config --list" r]
21 while {[gets $fd_rc line] >= 0} {
22 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
23 lappend repo_config($name) $value
24 }
25 }
26 close $fd_rc
27 }
28
29 if {[catch {set cfg_trust_mtime \
30 [lindex $repo_config(gui.trustmtime) 0]
31 }]} {
32 set cfg_trust_mtime false
33 }
34}
35
36proc save_my_config {} {
37 global repo_config
38 global cfg_trust_mtime
39
40 if {[catch {set rc_trustMTime $repo_config(gui.trustmtime)}]} {
41 set rc_trustMTime [list false]
42 }
43 if {$cfg_trust_mtime != [lindex $rc_trustMTime 0]} {
44 exec git repo-config gui.trustMTime $cfg_trust_mtime
45 set repo_config(gui.trustmtime) [list $cfg_trust_mtime]
46 }
47
48 set cfg_geometry [list \
49 [wm geometry .] \
50 [.vpane sash coord 0] \
51 [.vpane.files sash coord 0] \
52 ]
53 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
54 set rc_geometry [list [list]]
55 }
56 if {$cfg_geometry != [lindex $rc_geometry 0]} {
57 exec git repo-config gui.geometry $cfg_geometry
58 set repo_config(gui.geometry) [list $cfg_geometry]
59 }
60}
61
62######################################################################
63##
64## repository setup
65
66set appname [lindex [file split $argv0] end]
67set gitdir {}
68set GIT_COMMITTER_IDENT {}
69
70if {[catch {set cdup [exec git rev-parse --show-cdup]} err]} {
71 show_msg {} . "Cannot find the git directory: $err"
72 exit 1
73}
74if {$cdup != ""} {
75 cd $cdup
76}
77unset cdup
78
79if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
80 show_msg {} . "Cannot find the git directory: $err"
81 exit 1
82}
83
84if {$appname == {git-citool}} {
85 set single_commit 1
86}
87
88load_repo_config
89
cb07fc2a
SP
90######################################################################
91##
e210e674 92## task management
cb07fc2a 93
ec6b424a 94set single_commit 0
cb07fc2a 95set status_active 0
131f503b 96set diff_active 0
7fe7e733 97set update_active 0
ec6b424a 98set commit_active 0
131f503b
SP
99set update_index_fd {}
100
e210e674
SP
101set disable_on_lock [list]
102set index_lock_type none
103
e57ca85e
SP
104set HEAD {}
105set PARENT {}
106set commit_type {}
107
e210e674
SP
108proc lock_index {type} {
109 global index_lock_type disable_on_lock
131f503b 110
e210e674
SP
111 if {$index_lock_type == {none}} {
112 set index_lock_type $type
113 foreach w $disable_on_lock {
114 uplevel #0 $w disabled
115 }
116 return 1
117 } elseif {$index_lock_type == {begin-update} && $type == {update}} {
118 set index_lock_type $type
131f503b
SP
119 return 1
120 }
121 return 0
122}
cb07fc2a 123
e210e674
SP
124proc unlock_index {} {
125 global index_lock_type disable_on_lock
126
127 set index_lock_type none
128 foreach w $disable_on_lock {
129 uplevel #0 $w normal
130 }
131}
132
133######################################################################
134##
135## status
136
ec6b424a
SP
137proc repository_state {hdvar ctvar} {
138 global gitdir
139 upvar $hdvar hd $ctvar ct
140
141 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
142 set ct initial
143 } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
144 set ct merge
145 } else {
146 set ct normal
147 }
148}
149
e57ca85e
SP
150proc update_status {{final Ready.}} {
151 global HEAD PARENT commit_type
131f503b 152 global ui_index ui_other ui_status_value ui_comm
03e4ec53 153 global status_active file_states file_lists
e534f3a8 154 global cfg_trust_mtime
cb07fc2a 155
e210e674 156 if {$status_active || ![lock_index read]} return
cb07fc2a 157
e57ca85e
SP
158 repository_state new_HEAD new_type
159 if {$commit_type == {amend}
160 && $new_type == {normal}
161 && $new_HEAD == $HEAD} {
162 } else {
163 set HEAD $new_HEAD
164 set PARENT $new_HEAD
165 set commit_type $new_type
166 }
167
cb07fc2a 168 array unset file_states
03e4ec53 169 array unset file_lists
cb07fc2a
SP
170 foreach w [list $ui_index $ui_other] {
171 $w conf -state normal
172 $w delete 0.0 end
173 $w conf -state disabled
174 }
175
131f503b 176 if {![$ui_comm edit modified]
cc4b1c02 177 || [string trim [$ui_comm get 0.0 end]] == {}} {
131f503b
SP
178 if {[load_message GITGUI_MSG]} {
179 } elseif {[load_message MERGE_MSG]} {
180 } elseif {[load_message SQUASH_MSG]} {
181 }
182 $ui_comm edit modified false
b2c6fcf1 183 $ui_comm edit reset
131f503b
SP
184 }
185
e534f3a8
SP
186 if {$cfg_trust_mtime == {true}} {
187 update_status_stage2 {} $final
188 } else {
189 set status_active 1
190 set ui_status_value {Refreshing file status...}
191 set fd_rf [open "| git update-index -q --unmerged --refresh" r]
192 fconfigure $fd_rf -blocking 0 -translation binary
193 fileevent $fd_rf readable [list update_status_stage2 $fd_rf $final]
194 }
131f503b
SP
195}
196
e534f3a8 197proc update_status_stage2 {fd final} {
e57ca85e 198 global gitdir PARENT commit_type
131f503b 199 global ui_index ui_other ui_status_value ui_comm
03e4ec53 200 global status_active
868c8752 201 global buf_rdi buf_rdf buf_rlo
131f503b 202
e534f3a8
SP
203 if {$fd != {}} {
204 read $fd
205 if {![eof $fd]} return
206 close $fd
207 }
131f503b 208
cb07fc2a
SP
209 set ls_others [list | git ls-files --others -z \
210 --exclude-per-directory=.gitignore]
211 set info_exclude [file join $gitdir info exclude]
212 if {[file readable $info_exclude]} {
213 lappend ls_others "--exclude-from=$info_exclude"
214 }
215
868c8752
SP
216 set buf_rdi {}
217 set buf_rdf {}
218 set buf_rlo {}
219
131f503b
SP
220 set status_active 3
221 set ui_status_value {Scanning for modified files ...}
e57ca85e 222 set fd_di [open "| git diff-index --cached -z $PARENT" r]
cb07fc2a
SP
223 set fd_df [open "| git diff-files -z" r]
224 set fd_lo [open $ls_others r]
cb07fc2a
SP
225
226 fconfigure $fd_di -blocking 0 -translation binary
227 fconfigure $fd_df -blocking 0 -translation binary
228 fconfigure $fd_lo -blocking 0 -translation binary
e57ca85e
SP
229 fileevent $fd_di readable [list read_diff_index $fd_di $final]
230 fileevent $fd_df readable [list read_diff_files $fd_df $final]
231 fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
cb07fc2a
SP
232}
233
131f503b
SP
234proc load_message {file} {
235 global gitdir ui_comm
236
237 set f [file join $gitdir $file]
e57ca85e 238 if {[file isfile $f]} {
131f503b
SP
239 if {[catch {set fd [open $f r]}]} {
240 return 0
241 }
e57ca85e 242 set content [string trim [read $fd]]
131f503b
SP
243 close $fd
244 $ui_comm delete 0.0 end
245 $ui_comm insert end $content
246 return 1
247 }
248 return 0
249}
250
e57ca85e 251proc read_diff_index {fd final} {
cb07fc2a
SP
252 global buf_rdi
253
254 append buf_rdi [read $fd]
868c8752
SP
255 set c 0
256 set n [string length $buf_rdi]
257 while {$c < $n} {
258 set z1 [string first "\0" $buf_rdi $c]
259 if {$z1 == -1} break
260 incr z1
261 set z2 [string first "\0" $buf_rdi $z1]
262 if {$z2 == -1} break
263
264 set c $z2
265 incr z2 -1
266 display_file \
267 [string range $buf_rdi $z1 $z2] \
268 [string index $buf_rdi [expr $z1 - 2]]_
269 incr c
cb07fc2a 270 }
868c8752
SP
271 if {$c < $n} {
272 set buf_rdi [string range $buf_rdi $c end]
273 } else {
274 set buf_rdi {}
275 }
276
e57ca85e 277 status_eof $fd buf_rdi $final
cb07fc2a
SP
278}
279
e57ca85e 280proc read_diff_files {fd final} {
cb07fc2a
SP
281 global buf_rdf
282
283 append buf_rdf [read $fd]
868c8752
SP
284 set c 0
285 set n [string length $buf_rdf]
286 while {$c < $n} {
287 set z1 [string first "\0" $buf_rdf $c]
288 if {$z1 == -1} break
289 incr z1
290 set z2 [string first "\0" $buf_rdf $z1]
291 if {$z2 == -1} break
292
293 set c $z2
294 incr z2 -1
295 display_file \
296 [string range $buf_rdf $z1 $z2] \
297 _[string index $buf_rdf [expr $z1 - 2]]
298 incr c
299 }
300 if {$c < $n} {
301 set buf_rdf [string range $buf_rdf $c end]
302 } else {
303 set buf_rdf {}
cb07fc2a 304 }
868c8752 305
e57ca85e 306 status_eof $fd buf_rdf $final
cb07fc2a
SP
307}
308
e57ca85e 309proc read_ls_others {fd final} {
cb07fc2a
SP
310 global buf_rlo
311
312 append buf_rlo [read $fd]
313 set pck [split $buf_rlo "\0"]
314 set buf_rlo [lindex $pck end]
315 foreach p [lrange $pck 0 end-1] {
316 display_file $p _O
317 }
e57ca85e 318 status_eof $fd buf_rlo $final
cb07fc2a
SP
319}
320
e57ca85e 321proc status_eof {fd buf final} {
0fb8f9ce 322 global status_active $buf
e57ca85e 323 global ui_fname_value ui_status_value file_states
cb07fc2a
SP
324
325 if {[eof $fd]} {
326 set $buf {}
327 close $fd
93f654df 328
cb07fc2a 329 if {[incr status_active -1] == 0} {
e210e674 330 unlock_index
e57ca85e 331
93f654df 332 display_all_files
6b292675 333 set ui_status_value $final
93f654df 334
e57ca85e
SP
335 if {$ui_fname_value != {} && [array names file_states \
336 -exact $ui_fname_value] != {}} {
cb07fc2a 337 show_diff $ui_fname_value
e57ca85e
SP
338 } else {
339 clear_diff
cb07fc2a
SP
340 }
341 }
342 }
343}
344
345######################################################################
346##
347## diff
348
cb07fc2a 349proc clear_diff {} {
03e4ec53 350 global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
cb07fc2a
SP
351
352 $ui_diff conf -state normal
353 $ui_diff delete 0.0 end
354 $ui_diff conf -state disabled
03e4ec53 355
cb07fc2a
SP
356 set ui_fname_value {}
357 set ui_fstatus_value {}
03e4ec53
SP
358
359 $ui_index tag remove in_diff 0.0 end
360 $ui_other tag remove in_diff 0.0 end
cb07fc2a
SP
361}
362
03e4ec53
SP
363proc show_diff {path {w {}} {lno {}}} {
364 global file_states file_lists
365 global PARENT diff_3way diff_active
cb07fc2a
SP
366 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
367
e210e674 368 if {$diff_active || ![lock_index read]} return
cb07fc2a
SP
369
370 clear_diff
03e4ec53
SP
371 if {$w == {} || $lno == {}} {
372 foreach w [array names file_lists] {
373 set lno [lsearch -sorted $file_lists($w) $path]
374 if {$lno >= 0} {
375 incr lno
376 break
377 }
378 }
379 }
380 if {$w != {} && $lno >= 1} {
381 $w tag add in_diff $lno.0 [expr $lno + 1].0
382 }
383
cb07fc2a
SP
384 set s $file_states($path)
385 set m [lindex $s 0]
386 set diff_3way 0
387 set diff_active 1
68e009de 388 set ui_fname_value [escape_path $path]
cb07fc2a 389 set ui_fstatus_value [mapdesc $m $path]
68e009de 390 set ui_status_value "Loading diff of [escape_path $path]..."
cb07fc2a 391
e57ca85e 392 set cmd [list | git diff-index -p $PARENT -- $path]
cb07fc2a
SP
393 switch $m {
394 AM {
395 }
396 MM {
e57ca85e 397 set cmd [list | git diff-index -p -c $PARENT $path]
cb07fc2a
SP
398 }
399 _O {
400 if {[catch {
401 set fd [open $path r]
402 set content [read $fd]
403 close $fd
404 } err ]} {
131f503b 405 set diff_active 0
e210e674 406 unlock_index
68e009de 407 set ui_status_value "Unable to display [escape_path $path]"
cb07fc2a
SP
408 error_popup "Error loading file:\n$err"
409 return
410 }
411 $ui_diff conf -state normal
412 $ui_diff insert end $content
413 $ui_diff conf -state disabled
bd1e2b40
SP
414 set diff_active 0
415 unlock_index
416 set ui_status_value {Ready.}
cb07fc2a
SP
417 return
418 }
419 }
420
421 if {[catch {set fd [open $cmd r]} err]} {
131f503b 422 set diff_active 0
e210e674 423 unlock_index
68e009de 424 set ui_status_value "Unable to display [escape_path $path]"
cb07fc2a
SP
425 error_popup "Error loading diff:\n$err"
426 return
427 }
428
6f6eed28 429 fconfigure $fd -blocking 0 -translation auto
cb07fc2a
SP
430 fileevent $fd readable [list read_diff $fd]
431}
432
433proc read_diff {fd} {
434 global ui_diff ui_status_value diff_3way diff_active
435
436 while {[gets $fd line] >= 0} {
6f6eed28
SP
437 if {[string match {diff --git *} $line]} continue
438 if {[string match {diff --combined *} $line]} continue
439 if {[string match {--- *} $line]} continue
440 if {[string match {+++ *} $line]} continue
cb07fc2a
SP
441 if {[string match index* $line]} {
442 if {[string first , $line] >= 0} {
443 set diff_3way 1
444 }
445 }
446
447 $ui_diff conf -state normal
448 if {!$diff_3way} {
449 set x [string index $line 0]
450 switch -- $x {
451 "@" {set tags da}
452 "+" {set tags dp}
453 "-" {set tags dm}
454 default {set tags {}}
455 }
456 } else {
457 set x [string range $line 0 1]
458 switch -- $x {
459 default {set tags {}}
460 "@@" {set tags da}
461 "++" {set tags dp; set x " +"}
462 " +" {set tags {di bold}; set x "++"}
463 "+ " {set tags dni; set x "-+"}
464 "--" {set tags dm; set x " -"}
465 " -" {set tags {dm bold}; set x "--"}
466 "- " {set tags di; set x "+-"}
467 default {set tags {}}
468 }
469 set line [string replace $line 0 1 $x]
470 }
471 $ui_diff insert end $line $tags
472 $ui_diff insert end "\n"
473 $ui_diff conf -state disabled
474 }
475
476 if {[eof $fd]} {
477 close $fd
478 set diff_active 0
e210e674 479 unlock_index
cb07fc2a
SP
480 set ui_status_value {Ready.}
481 }
482}
483
ec6b424a
SP
484######################################################################
485##
486## commit
487
e57ca85e
SP
488proc load_last_commit {} {
489 global HEAD PARENT commit_type ui_comm
490
491 if {$commit_type == {amend}} return
492 if {$commit_type != {normal}} {
493 error_popup "Can't amend a $commit_type commit."
494 return
495 }
496
497 set msg {}
498 set parent {}
499 set parent_count 0
500 if {[catch {
501 set fd [open "| git cat-file commit $HEAD" r]
502 while {[gets $fd line] > 0} {
503 if {[string match {parent *} $line]} {
504 set parent [string range $line 7 end]
505 incr parent_count
506 }
507 }
508 set msg [string trim [read $fd]]
509 close $fd
510 } err]} {
511 error_popup "Error loading commit data for amend:\n$err"
512 return
513 }
514
515 if {$parent_count == 0} {
516 set commit_type amend
517 set HEAD {}
518 set PARENT {}
519 update_status
520 } elseif {$parent_count == 1} {
521 set commit_type amend
522 set PARENT $parent
523 $ui_comm delete 0.0 end
524 $ui_comm insert end $msg
525 $ui_comm edit modified false
b2c6fcf1 526 $ui_comm edit reset
e57ca85e
SP
527 update_status
528 } else {
529 error_popup {You can't amend a merge commit.}
530 return
531 }
532}
533
ec6b424a
SP
534proc commit_tree {} {
535 global tcl_platform HEAD gitdir commit_type file_states
536 global commit_active ui_status_value
537 global ui_comm
538
539 if {$commit_active || ![lock_index update]} return
540
541 # -- Our in memory state should match the repository.
542 #
543 repository_state curHEAD cur_type
e57ca85e
SP
544 if {$commit_type == {amend}
545 && $cur_type == {normal}
546 && $curHEAD == $HEAD} {
547 } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
ec6b424a
SP
548 error_popup {Last scanned state does not match repository state.
549
550Its highly likely that another Git program modified the
551repository since our last scan. A rescan is required
552before committing.
553}
554 unlock_index
555 update_status
556 return
557 }
558
559 # -- At least one file should differ in the index.
560 #
561 set files_ready 0
562 foreach path [array names file_states] {
563 set s $file_states($path)
564 switch -glob -- [lindex $s 0] {
565 _* {continue}
566 A* -
567 D* -
568 M* {set files_ready 1; break}
569 U* {
570 error_popup "Unmerged files cannot be committed.
571
68e009de 572File [escape_path $path] has merge conflicts.
7fe7e733 573You must resolve them and include the file before committing.
ec6b424a
SP
574"
575 unlock_index
576 return
577 }
578 default {
579 error_popup "Unknown file state [lindex $s 0] detected.
580
68e009de 581File [escape_path $path] cannot be committed by this program.
ec6b424a
SP
582"
583 }
584 }
585 }
586 if {!$files_ready} {
7fe7e733 587 error_popup {No included files to commit.
ec6b424a 588
7fe7e733 589You must include at least 1 file before you can commit.
ec6b424a
SP
590}
591 unlock_index
592 return
593 }
594
595 # -- A message is required.
596 #
597 set msg [string trim [$ui_comm get 1.0 end]]
598 if {$msg == {}} {
599 error_popup {Please supply a commit message.
600
601A good commit message has the following format:
602
603- First line: Describe in one sentance what you did.
604- Second line: Blank
605- Remaining lines: Describe why this change is good.
606}
607 unlock_index
608 return
609 }
610
611 # -- Ask the pre-commit hook for the go-ahead.
612 #
613 set pchook [file join $gitdir hooks pre-commit]
e57ca85e 614 if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
ec6b424a
SP
615 set pchook [list sh -c \
616 "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
617 } elseif {[file executable $pchook]} {
618 set pchook [list $pchook]
619 } else {
620 set pchook {}
621 }
622 if {$pchook != {} && [catch {eval exec $pchook} err]} {
623 hook_failed_popup pre-commit $err
624 unlock_index
625 return
626 }
627
628 # -- Write the tree in the background.
629 #
630 set commit_active 1
631 set ui_status_value {Committing changes...}
632
633 set fd_wt [open "| git write-tree" r]
bd1e2b40 634 fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
ec6b424a
SP
635}
636
637proc commit_stage2 {fd_wt curHEAD msg} {
e57ca85e
SP
638 global single_commit gitdir PARENT commit_type
639 global commit_active ui_status_value ui_comm
ec6b424a
SP
640
641 gets $fd_wt tree_id
642 close $fd_wt
643
644 if {$tree_id == {}} {
645 error_popup "write-tree failed"
646 set commit_active 0
647 set ui_status_value {Commit failed.}
648 unlock_index
649 return
650 }
651
652 # -- Create the commit.
653 #
654 set cmd [list git commit-tree $tree_id]
e57ca85e
SP
655 if {$PARENT != {}} {
656 lappend cmd -p $PARENT
ec6b424a
SP
657 }
658 if {$commit_type == {merge}} {
659 if {[catch {
660 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
bd1e2b40
SP
661 while {[gets $fd_mh merge_head] >= 0} {
662 lappend cmd -p $merge_head
ec6b424a
SP
663 }
664 close $fd_mh
665 } err]} {
666 error_popup "Loading MERGE_HEADs failed:\n$err"
667 set commit_active 0
668 set ui_status_value {Commit failed.}
669 unlock_index
670 return
671 }
672 }
e57ca85e 673 if {$PARENT == {}} {
ec6b424a
SP
674 # git commit-tree writes to stderr during initial commit.
675 lappend cmd 2>/dev/null
676 }
677 lappend cmd << $msg
678 if {[catch {set cmt_id [eval exec $cmd]} err]} {
679 error_popup "commit-tree failed:\n$err"
680 set commit_active 0
681 set ui_status_value {Commit failed.}
682 unlock_index
683 return
684 }
685
686 # -- Update the HEAD ref.
687 #
688 set reflogm commit
689 if {$commit_type != {normal}} {
690 append reflogm " ($commit_type)"
691 }
692 set i [string first "\n" $msg]
693 if {$i >= 0} {
694 append reflogm {: } [string range $msg 0 [expr $i - 1]]
695 } else {
696 append reflogm {: } $msg
697 }
e57ca85e 698 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
ec6b424a
SP
699 if {[catch {eval exec $cmd} err]} {
700 error_popup "update-ref failed:\n$err"
701 set commit_active 0
702 set ui_status_value {Commit failed.}
703 unlock_index
704 return
705 }
706
707 # -- Cleanup after ourselves.
708 #
709 catch {file delete [file join $gitdir MERGE_HEAD]}
710 catch {file delete [file join $gitdir MERGE_MSG]}
711 catch {file delete [file join $gitdir SQUASH_MSG]}
712 catch {file delete [file join $gitdir GITGUI_MSG]}
713
714 # -- Let rerere do its thing.
715 #
716 if {[file isdirectory [file join $gitdir rr-cache]]} {
717 catch {exec git rerere}
718 }
719
e57ca85e
SP
720 $ui_comm delete 0.0 end
721 $ui_comm edit modified false
b2c6fcf1 722 $ui_comm edit reset
ec6b424a
SP
723
724 if {$single_commit} do_quit
725
e57ca85e 726 set commit_type {}
ec6b424a 727 set commit_active 0
bd1e2b40
SP
728 set HEAD $cmt_id
729 set PARENT $cmt_id
ec6b424a 730 unlock_index
d4ab2035 731 update_status "Changes committed as [string range $cmt_id 0 7]."
ec6b424a
SP
732}
733
8c0ce436
SP
734######################################################################
735##
736## fetch pull push
737
738proc fetch_from {remote} {
739 set w [new_console "fetch $remote" \
740 "Fetching new changes from $remote"]
cc4b1c02 741 set cmd [list git fetch]
8c0ce436 742 lappend cmd $remote
cc4b1c02 743 console_exec $w $cmd
8c0ce436
SP
744}
745
d33ba5fa 746proc pull_remote {remote branch} {
ec39d83a
SP
747 global HEAD commit_type
748 global file_states
749
988b8a7d 750 if {![lock_index update]} return
ec39d83a
SP
751
752 # -- Our in memory state should match the repository.
753 #
754 repository_state curHEAD cur_type
755 if {$commit_type != $cur_type || $HEAD != $curHEAD} {
756 error_popup {Last scanned state does not match repository state.
757
758Its highly likely that another Git program modified the
759repository since our last scan. A rescan is required
760before a pull can be started.
761}
762 unlock_index
763 update_status
764 return
765 }
766
767 # -- No differences should exist before a pull.
768 #
769 if {[array size file_states] != 0} {
770 error_popup {Uncommitted but modified files are present.
771
772You should not perform a pull with unmodified files in your working
773directory as Git would be unable to recover from an incorrect merge.
774
775Commit or throw away all changes before starting a pull operation.
776}
777 unlock_index
778 return
779 }
780
d33ba5fa
SP
781 set w [new_console "pull $remote $branch" \
782 "Pulling new changes from branch $branch in $remote"]
783 set cmd [list git pull]
784 lappend cmd $remote
785 lappend cmd $branch
786 console_exec $w $cmd [list post_pull_remote $remote $branch]
787}
788
789proc post_pull_remote {remote branch success} {
ec39d83a
SP
790 global HEAD PARENT commit_type
791 global ui_status_value
792
988b8a7d 793 unlock_index
d33ba5fa 794 if {$success} {
ec39d83a
SP
795 repository_state HEAD commit_type
796 set PARENT $HEAD
797 set $ui_status_value {Ready.}
d33ba5fa
SP
798 } else {
799 update_status "Conflicts detected while pulling $branch from $remote."
800 }
801}
802
8c0ce436
SP
803proc push_to {remote} {
804 set w [new_console "push $remote" \
805 "Pushing changes to $remote"]
cc4b1c02 806 set cmd [list git push]
8c0ce436 807 lappend cmd $remote
cc4b1c02 808 console_exec $w $cmd
8c0ce436
SP
809}
810
cb07fc2a
SP
811######################################################################
812##
813## ui helpers
814
815proc mapcol {state path} {
6b292675 816 global all_cols ui_other
cb07fc2a
SP
817
818 if {[catch {set r $all_cols($state)}]} {
819 puts "error: no column for state={$state} $path"
6b292675 820 return $ui_other
cb07fc2a
SP
821 }
822 return $r
823}
824
825proc mapicon {state path} {
826 global all_icons
827
828 if {[catch {set r $all_icons($state)}]} {
829 puts "error: no icon for state={$state} $path"
830 return file_plain
831 }
832 return $r
833}
834
835proc mapdesc {state path} {
836 global all_descs
837
838 if {[catch {set r $all_descs($state)}]} {
839 puts "error: no desc for state={$state} $path"
840 return $state
841 }
842 return $r
843}
844
68e009de
SP
845proc escape_path {path} {
846 regsub -all "\n" $path "\\n" path
847 return $path
848}
849
93f654df
SP
850set next_icon_id 0
851
6b292675 852proc merge_state {path new_state} {
93f654df 853 global file_states next_icon_id
cb07fc2a 854
6b292675
SP
855 set s0 [string index $new_state 0]
856 set s1 [string index $new_state 1]
857
858 if {[catch {set info $file_states($path)}]} {
859 set state __
860 set icon n[incr next_icon_id]
cb07fc2a 861 } else {
6b292675
SP
862 set state [lindex $info 0]
863 set icon [lindex $info 1]
cb07fc2a
SP
864 }
865
6b292675
SP
866 if {$s0 == {_}} {
867 set s0 [string index $state 0]
868 } elseif {$s0 == {*}} {
869 set s0 _
cb07fc2a
SP
870 }
871
6b292675
SP
872 if {$s1 == {_}} {
873 set s1 [string index $state 1]
874 } elseif {$s1 == {*}} {
875 set s1 _
cb07fc2a
SP
876 }
877
6b292675
SP
878 set file_states($path) [list $s0$s1 $icon]
879 return $state
cb07fc2a
SP
880}
881
882proc display_file {path state} {
03e4ec53
SP
883 global ui_index ui_other
884 global file_states file_lists status_active
cb07fc2a
SP
885
886 set old_m [merge_state $path $state]
93f654df
SP
887 if {$status_active} return
888
cb07fc2a 889 set s $file_states($path)
93f654df 890 set new_m [lindex $s 0]
0fb8f9ce
SP
891 set new_w [mapcol $new_m $path]
892 set old_w [mapcol $old_m $path]
893 set new_icon [mapicon $new_m $path]
cb07fc2a 894
6b292675 895 if {$new_w != $old_w} {
03e4ec53 896 set lno [lsearch -sorted $file_lists($old_w) $path]
cb07fc2a
SP
897 if {$lno >= 0} {
898 incr lno
93f654df
SP
899 $old_w conf -state normal
900 $old_w delete $lno.0 [expr $lno + 1].0
901 $old_w conf -state disabled
cb07fc2a 902 }
93f654df 903
03e4ec53
SP
904 lappend file_lists($new_w) $path
905 set file_lists($new_w) [lsort $file_lists($new_w)]
906 set lno [lsearch -sorted $file_lists($new_w) $path]
907 incr lno
93f654df
SP
908 $new_w conf -state normal
909 $new_w image create $lno.0 \
910 -align center -padx 5 -pady 1 \
911 -name [lindex $s 1] \
e4ee9af4 912 -image $new_icon
68e009de 913 $new_w insert $lno.1 "[escape_path $path]\n"
93f654df
SP
914 $new_w conf -state disabled
915 } elseif {$new_icon != [mapicon $old_m $path]} {
916 $new_w conf -state normal
917 $new_w image conf [lindex $s 1] -image $new_icon
918 $new_w conf -state disabled
cb07fc2a 919 }
93f654df 920}
cb07fc2a 921
93f654df 922proc display_all_files {} {
03e4ec53 923 global ui_index ui_other file_states file_lists
93f654df
SP
924
925 $ui_index conf -state normal
926 $ui_other conf -state normal
927
928 foreach path [lsort [array names file_states]] {
929 set s $file_states($path)
930 set m [lindex $s 0]
6b292675 931 set w [mapcol $m $path]
03e4ec53 932 lappend file_lists($w) $path
6b292675 933 $w image create end \
cb07fc2a 934 -align center -padx 5 -pady 1 \
93f654df
SP
935 -name [lindex $s 1] \
936 -image [mapicon $m $path]
68e009de 937 $w insert end "[escape_path $path]\n"
cb07fc2a 938 }
93f654df
SP
939
940 $ui_index conf -state disabled
941 $ui_other conf -state disabled
cb07fc2a
SP
942}
943
131f503b
SP
944proc with_update_index {body} {
945 global update_index_fd
946
947 if {$update_index_fd == {}} {
e210e674 948 if {![lock_index update]} return
131f503b
SP
949 set update_index_fd [open \
950 "| git update-index --add --remove -z --stdin" \
951 w]
952 fconfigure $update_index_fd -translation binary
953 uplevel 1 $body
954 close $update_index_fd
955 set update_index_fd {}
e210e674 956 unlock_index
131f503b
SP
957 } else {
958 uplevel 1 $body
959 }
960}
961
962proc update_index {path} {
963 global update_index_fd
964
965 if {$update_index_fd == {}} {
966 error {not in with_update_index}
967 } else {
968 puts -nonewline $update_index_fd "$path\0"
969 }
970}
971
cb07fc2a 972proc toggle_mode {path} {
bd1e2b40 973 global file_states ui_fname_value
cb07fc2a
SP
974
975 set s $file_states($path)
976 set m [lindex $s 0]
977
978 switch -- $m {
979 AM -
131f503b
SP
980 _O {set new A*}
981 _M -
982 MM {set new M*}
bd1e2b40 983 AD -
131f503b
SP
984 _D {set new D*}
985 default {return}
cb07fc2a
SP
986 }
987
131f503b 988 with_update_index {update_index $path}
cb07fc2a 989 display_file $path $new
bd1e2b40
SP
990 if {$ui_fname_value == $path} {
991 show_diff $path
992 }
cb07fc2a
SP
993}
994
8c0ce436
SP
995######################################################################
996##
2d19516d 997## remote management
0d4f3eb5 998
8c0ce436 999proc load_all_remotes {} {
0d4f3eb5 1000 global gitdir all_remotes repo_config
8c0ce436
SP
1001
1002 set all_remotes [list]
1003 set rm_dir [file join $gitdir remotes]
1004 if {[file isdirectory $rm_dir]} {
d47ae541
SP
1005 set all_remotes [concat $all_remotes [glob \
1006 -types f \
1007 -tails \
1008 -nocomplain \
1009 -directory $rm_dir *]]
8c0ce436
SP
1010 }
1011
0d4f3eb5
SP
1012 foreach line [array names repo_config remote.*.url] {
1013 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
8c0ce436
SP
1014 lappend all_remotes $name
1015 }
1016 }
8c0ce436
SP
1017
1018 set all_remotes [lsort -unique $all_remotes]
1019}
1020
1021proc populate_remote_menu {m pfx op} {
d33ba5fa 1022 global all_remotes mainfont
8c0ce436
SP
1023
1024 foreach remote $all_remotes {
1025 $m add command -label "$pfx $remote..." \
1026 -command [list $op $remote] \
1027 -font $mainfont
1028 }
1029}
1030
d33ba5fa 1031proc populate_pull_menu {m} {
0a462d67 1032 global gitdir repo_config all_remotes mainfont disable_on_lock
d33ba5fa
SP
1033
1034 foreach remote $all_remotes {
1035 set rb {}
1036 if {[array get repo_config remote.$remote.url] != {}} {
1037 if {[array get repo_config remote.$remote.fetch] != {}} {
1038 regexp {^([^:]+):} \
1039 [lindex $repo_config(remote.$remote.fetch) 0] \
1040 line rb
1041 }
1042 } else {
1043 catch {
1044 set fd [open [file join $gitdir remotes $remote] r]
1045 while {[gets $fd line] >= 0} {
1046 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1047 break
1048 }
1049 }
1050 close $fd
1051 }
1052 }
1053
1054 set rb_short $rb
1055 regsub ^refs/heads/ $rb {} rb_short
1056 if {$rb_short != {}} {
1057 $m add command \
1058 -label "Branch $rb_short from $remote..." \
1059 -command [list pull_remote $remote $rb] \
1060 -font $mainfont
0a462d67
SP
1061 lappend disable_on_lock \
1062 [list $m entryconf [$m index last] -state]
d33ba5fa
SP
1063 }
1064 }
1065}
1066
cb07fc2a
SP
1067######################################################################
1068##
1069## icons
1070
1071set filemask {
1072#define mask_width 14
1073#define mask_height 15
1074static unsigned char mask_bits[] = {
1075 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1076 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1077 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1078}
1079
1080image create bitmap file_plain -background white -foreground black -data {
1081#define plain_width 14
1082#define plain_height 15
1083static unsigned char plain_bits[] = {
1084 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1085 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1086 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1087} -maskdata $filemask
1088
1089image create bitmap file_mod -background white -foreground blue -data {
1090#define mod_width 14
1091#define mod_height 15
1092static unsigned char mod_bits[] = {
1093 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1094 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1095 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1096} -maskdata $filemask
1097
131f503b
SP
1098image create bitmap file_fulltick -background white -foreground "#007000" -data {
1099#define file_fulltick_width 14
1100#define file_fulltick_height 15
1101static unsigned char file_fulltick_bits[] = {
cb07fc2a
SP
1102 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1103 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1104 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1105} -maskdata $filemask
1106
1107image create bitmap file_parttick -background white -foreground "#005050" -data {
1108#define parttick_width 14
1109#define parttick_height 15
1110static unsigned char parttick_bits[] = {
1111 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1112 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1113 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1114} -maskdata $filemask
1115
1116image create bitmap file_question -background white -foreground black -data {
1117#define file_question_width 14
1118#define file_question_height 15
1119static unsigned char file_question_bits[] = {
1120 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1121 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1122 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1123} -maskdata $filemask
1124
1125image create bitmap file_removed -background white -foreground red -data {
1126#define file_removed_width 14
1127#define file_removed_height 15
1128static unsigned char file_removed_bits[] = {
1129 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1130 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1131 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1132} -maskdata $filemask
1133
1134image create bitmap file_merge -background white -foreground blue -data {
1135#define file_merge_width 14
1136#define file_merge_height 15
1137static unsigned char file_merge_bits[] = {
1138 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1139 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1140 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1141} -maskdata $filemask
1142
6b292675
SP
1143set ui_index .vpane.files.index.list
1144set ui_other .vpane.files.other.list
131f503b 1145set max_status_desc 0
cb07fc2a 1146foreach i {
131f503b
SP
1147 {__ i plain "Unmodified"}
1148 {_M i mod "Modified"}
1149 {M_ i fulltick "Checked in"}
7fe7e733 1150 {MM i parttick "Partially included"}
131f503b
SP
1151
1152 {_O o plain "Untracked"}
1153 {A_ o fulltick "Added"}
1154 {AM o parttick "Partially added"}
6b292675 1155 {AD o question "Added (but now gone)"}
131f503b
SP
1156
1157 {_D i question "Missing"}
1158 {D_ i removed "Removed"}
1159 {DD i removed "Removed"}
1160 {DO i removed "Removed (still exists)"}
1161
1162 {UM i merge "Merge conflicts"}
1163 {U_ i merge "Merge conflicts"}
cb07fc2a 1164 } {
131f503b
SP
1165 if {$max_status_desc < [string length [lindex $i 3]]} {
1166 set max_status_desc [string length [lindex $i 3]]
1167 }
6b292675
SP
1168 if {[lindex $i 1] == {i}} {
1169 set all_cols([lindex $i 0]) $ui_index
1170 } else {
1171 set all_cols([lindex $i 0]) $ui_other
1172 }
131f503b
SP
1173 set all_icons([lindex $i 0]) file_[lindex $i 2]
1174 set all_descs([lindex $i 0]) [lindex $i 3]
cb07fc2a
SP
1175}
1176unset filemask i
1177
1178######################################################################
1179##
1180## util
1181
1182proc error_popup {msg} {
1183 set w .error
1184 toplevel $w
1185 wm transient $w .
1186 show_msg $w $w $msg
1187}
1188
1189proc show_msg {w top msg} {
b8ce6f0e 1190 global gitdir appname mainfont
6e27d826
SP
1191
1192 message $w.m -text $msg -justify left -aspect 400
ec6b424a
SP
1193 pack $w.m -side top -fill x -padx 5 -pady 10
1194 button $w.ok -text OK \
1195 -width 15 \
8c0ce436 1196 -font $mainfont \
ec6b424a 1197 -command "destroy $top"
6e27d826 1198 pack $w.ok -side bottom
cb07fc2a
SP
1199 bind $top <Visibility> "grab $top; focus $top"
1200 bind $top <Key-Return> "destroy $top"
d33ba5fa
SP
1201 wm title $w "$appname ([lindex [file split \
1202 [file normalize [file dirname $gitdir]]] \
1203 end]): error"
cb07fc2a
SP
1204 tkwait window $top
1205}
1206
6e27d826 1207proc hook_failed_popup {hook msg} {
ec6b424a 1208 global gitdir mainfont difffont appname
6e27d826
SP
1209
1210 set w .hookfail
1211 toplevel $w
1212 wm transient $w .
1213
1214 frame $w.m
1215 label $w.m.l1 -text "$hook hook failed:" \
1216 -anchor w \
1217 -justify left \
1218 -font [concat $mainfont bold]
1219 text $w.m.t \
1220 -background white -borderwidth 1 \
1221 -relief sunken \
1222 -width 80 -height 10 \
1223 -font $difffont \
1224 -yscrollcommand [list $w.m.sby set]
1225 label $w.m.l2 \
1226 -text {You must correct the above errors before committing.} \
1227 -anchor w \
1228 -justify left \
1229 -font [concat $mainfont bold]
1230 scrollbar $w.m.sby -command [list $w.m.t yview]
1231 pack $w.m.l1 -side top -fill x
1232 pack $w.m.l2 -side bottom -fill x
1233 pack $w.m.sby -side right -fill y
1234 pack $w.m.t -side left -fill both -expand 1
1235 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1236
1237 $w.m.t insert 1.0 $msg
1238 $w.m.t conf -state disabled
1239
1240 button $w.ok -text OK \
1241 -width 15 \
8c0ce436 1242 -font $mainfont \
6e27d826
SP
1243 -command "destroy $w"
1244 pack $w.ok -side bottom
1245
1246 bind $w <Visibility> "grab $w; focus $w"
1247 bind $w <Key-Return> "destroy $w"
d33ba5fa
SP
1248 wm title $w "$appname ([lindex [file split \
1249 [file normalize [file dirname $gitdir]]] \
1250 end]): error"
6e27d826
SP
1251 tkwait window $w
1252}
1253
8c0ce436
SP
1254set next_console_id 0
1255
1256proc new_console {short_title long_title} {
37af79d1
SP
1257 global next_console_id console_data
1258 set w .console[incr next_console_id]
1259 set console_data($w) [list $short_title $long_title]
1260 return [console_init $w]
1261}
1262
1263proc console_init {w} {
1264 global console_cr console_data
ee3dc935 1265 global gitdir appname mainfont difffont
8c0ce436 1266
ee3dc935 1267 set console_cr($w) 1.0
8c0ce436
SP
1268 toplevel $w
1269 frame $w.m
37af79d1 1270 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
8c0ce436
SP
1271 -anchor w \
1272 -justify left \
1273 -font [concat $mainfont bold]
1274 text $w.m.t \
1275 -background white -borderwidth 1 \
1276 -relief sunken \
1277 -width 80 -height 10 \
1278 -font $difffont \
1279 -state disabled \
1280 -yscrollcommand [list $w.m.sby set]
07123f40
SP
1281 label $w.m.s -anchor w \
1282 -justify left \
1283 -font [concat $mainfont bold]
8c0ce436
SP
1284 scrollbar $w.m.sby -command [list $w.m.t yview]
1285 pack $w.m.l1 -side top -fill x
07123f40 1286 pack $w.m.s -side bottom -fill x
8c0ce436
SP
1287 pack $w.m.sby -side right -fill y
1288 pack $w.m.t -side left -fill both -expand 1
1289 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1290
ee3dc935 1291 button $w.ok -text {Running...} \
8c0ce436
SP
1292 -width 15 \
1293 -font $mainfont \
1294 -state disabled \
1295 -command "destroy $w"
1296 pack $w.ok -side bottom
1297
1298 bind $w <Visibility> "focus $w"
d33ba5fa
SP
1299 wm title $w "$appname ([lindex [file split \
1300 [file normalize [file dirname $gitdir]]] \
1301 end]): [lindex $console_data($w) 0]"
8c0ce436
SP
1302 return $w
1303}
1304
d33ba5fa 1305proc console_exec {w cmd {after {}}} {
cc4b1c02
SP
1306 global tcl_platform
1307
1308 # -- Windows tosses the enviroment when we exec our child.
1309 # But most users need that so we have to relogin. :-(
1310 #
1311 if {$tcl_platform(platform) == {windows}} {
1312 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1313 }
1314
1315 # -- Tcl won't let us redirect both stdout and stderr to
1316 # the same pipe. So pass it through cat...
1317 #
1318 set cmd [concat | $cmd |& cat]
1319
1320 set fd_f [open $cmd r]
ee3dc935 1321 fconfigure $fd_f -blocking 0 -translation binary
d33ba5fa 1322 fileevent $fd_f readable [list console_read $w $fd_f $after]
cc4b1c02
SP
1323}
1324
d33ba5fa 1325proc console_read {w fd after} {
37af79d1 1326 global console_cr console_data
ee3dc935 1327
ee3dc935 1328 set buf [read $fd]
37af79d1
SP
1329 if {$buf != {}} {
1330 if {![winfo exists $w]} {console_init $w}
1331 $w.m.t conf -state normal
1332 set c 0
1333 set n [string length $buf]
1334 while {$c < $n} {
1335 set cr [string first "\r" $buf $c]
1336 set lf [string first "\n" $buf $c]
1337 if {$cr < 0} {set cr [expr $n + 1]}
1338 if {$lf < 0} {set lf [expr $n + 1]}
1339
1340 if {$lf < $cr} {
1341 $w.m.t insert end [string range $buf $c $lf]
1342 set console_cr($w) [$w.m.t index {end -1c}]
1343 set c $lf
1344 incr c
1345 } else {
1346 $w.m.t delete $console_cr($w) end
1347 $w.m.t insert end "\n"
1348 $w.m.t insert end [string range $buf $c $cr]
1349 set c $cr
1350 incr c
1351 }
ee3dc935 1352 }
37af79d1
SP
1353 $w.m.t conf -state disabled
1354 $w.m.t see end
8c0ce436 1355 }
8c0ce436 1356
07123f40 1357 fconfigure $fd -blocking 1
8c0ce436 1358 if {[eof $fd]} {
07123f40 1359 if {[catch {close $fd}]} {
37af79d1 1360 if {![winfo exists $w]} {console_init $w}
07123f40 1361 $w.m.s conf -background red -text {Error: Command Failed}
37af79d1
SP
1362 $w.ok conf -text Close
1363 $w.ok conf -state normal
d33ba5fa 1364 set ok 0
37af79d1 1365 } elseif {[winfo exists $w]} {
07123f40 1366 $w.m.s conf -background green -text {Success}
37af79d1
SP
1367 $w.ok conf -text Close
1368 $w.ok conf -state normal
d33ba5fa 1369 set ok 1
07123f40 1370 }
ee3dc935 1371 array unset console_cr $w
37af79d1 1372 array unset console_data $w
d33ba5fa
SP
1373 if {$after != {}} {
1374 uplevel #0 $after $ok
1375 }
07123f40 1376 return
8c0ce436 1377 }
07123f40 1378 fconfigure $fd -blocking 0
8c0ce436
SP
1379}
1380
cb07fc2a
SP
1381######################################################################
1382##
1383## ui commands
1384
e210e674 1385set starting_gitk_msg {Please wait... Starting gitk...}
cc4b1c02 1386
cb07fc2a 1387proc do_gitk {} {
e210e674
SP
1388 global tcl_platform ui_status_value starting_gitk_msg
1389
1390 set ui_status_value $starting_gitk_msg
e57ca85e 1391 after 10000 {
e210e674
SP
1392 if {$ui_status_value == $starting_gitk_msg} {
1393 set ui_status_value {Ready.}
1394 }
1395 }
cb07fc2a 1396
cc4b1c02 1397 if {$tcl_platform(platform) == {windows}} {
cb07fc2a
SP
1398 exec sh -c gitk &
1399 } else {
1400 exec gitk &
1401 }
1402}
1403
d1536c48
SP
1404proc do_repack {} {
1405 set w [new_console "repack" "Repacking the object database"]
1406 set cmd [list git repack]
1407 lappend cmd -a
1408 lappend cmd -d
1409 console_exec $w $cmd
1410}
1411
cb07fc2a 1412proc do_quit {} {
131f503b
SP
1413 global gitdir ui_comm
1414
1415 set save [file join $gitdir GITGUI_MSG]
ec6b424a
SP
1416 set msg [string trim [$ui_comm get 0.0 end]]
1417 if {[$ui_comm edit modified] && $msg != {}} {
131f503b
SP
1418 catch {
1419 set fd [open $save w]
1420 puts $fd [string trim [$ui_comm get 0.0 end]]
1421 close $fd
1422 }
ec6b424a 1423 } elseif {$msg == {} && [file exists $save]} {
131f503b
SP
1424 file delete $save
1425 }
1426
e534f3a8 1427 save_my_config
cb07fc2a
SP
1428 destroy .
1429}
1430
1431proc do_rescan {} {
1432 update_status
1433}
1434
7fe7e733
SP
1435proc do_include_all {} {
1436 global update_active ui_status_value
131f503b 1437
7fe7e733 1438 if {$update_active || ![lock_index begin-update]} return
131f503b 1439
7fe7e733
SP
1440 set update_active 1
1441 set ui_status_value {Including all modified files...}
131f503b
SP
1442 after 1 {
1443 with_update_index {
1444 foreach path [array names file_states] {
1445 set s $file_states($path)
1446 set m [lindex $s 0]
1447 switch -- $m {
1448 AM -
1449 MM -
1450 _M -
1451 _D {toggle_mode $path}
1452 }
1453 }
1454 }
7fe7e733 1455 set update_active 0
131f503b
SP
1456 set ui_status_value {Ready.}
1457 }
1458}
1459
1460proc do_signoff {} {
97bf01c4 1461 global ui_comm GIT_COMMITTER_IDENT
131f503b 1462
97bf01c4
SP
1463 if {$GIT_COMMITTER_IDENT == {}} {
1464 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1465 error_popup "Unable to obtain your identity:\n$err"
1466 return
131f503b 1467 }
97bf01c4
SP
1468 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1469 $me me GIT_COMMITTER_IDENT]} {
1470 error_popup "Invalid GIT_COMMITTER_IDENT:\n$me"
1471 return
1472 }
1473 }
1474
1475 set str "Signed-off-by: $GIT_COMMITTER_IDENT"
1476 if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
b2c6fcf1
SP
1477 $ui_comm edit separator
1478 $ui_comm insert end "\n$str"
1479 $ui_comm edit separator
97bf01c4 1480 $ui_comm see end
131f503b
SP
1481 }
1482}
1483
e57ca85e
SP
1484proc do_amend_last {} {
1485 load_last_commit
1486}
1487
6e27d826 1488proc do_commit {} {
ec6b424a 1489 commit_tree
6e27d826
SP
1490}
1491
cb07fc2a
SP
1492# shift == 1: left click
1493# 3: right click
1494proc click {w x y shift wx wy} {
03e4ec53 1495 global ui_index ui_other file_lists
131f503b 1496
cb07fc2a
SP
1497 set pos [split [$w index @$x,$y] .]
1498 set lno [lindex $pos 0]
1499 set col [lindex $pos 1]
03e4ec53 1500 set path [lindex $file_lists($w) [expr $lno - 1]]
cb07fc2a
SP
1501 if {$path == {}} return
1502
1503 if {$col > 0 && $shift == 1} {
03e4ec53 1504 show_diff $path $w $lno
cb07fc2a
SP
1505 }
1506}
1507
1508proc unclick {w x y} {
1509 set pos [split [$w index @$x,$y] .]
1510 set lno [lindex $pos 0]
1511 set col [lindex $pos 1]
1512 set path [$w get $lno.1 $lno.end]
1513 if {$path == {}} return
1514
e210e674 1515 if {$col == 0} {
cb07fc2a
SP
1516 toggle_mode $path
1517 }
1518}
1519
1520######################################################################
1521##
1522## ui init
1523
1524set mainfont {Helvetica 10}
1525set difffont {Courier 10}
1526set maincursor [. cget -cursor]
1527
66144892
SP
1528switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1529windows,* {set M1B Control; set M1T Ctrl}
1530unix,Darwin {set M1B M1; set M1T Cmd}
1531default {set M1B M1; set M1T M1}
e210e674
SP
1532}
1533
cb07fc2a
SP
1534# -- Menu Bar
1535menu .mbar -tearoff 0
1536.mbar add cascade -label Project -menu .mbar.project
9861671d 1537.mbar add cascade -label Edit -menu .mbar.edit
cb07fc2a
SP
1538.mbar add cascade -label Commit -menu .mbar.commit
1539.mbar add cascade -label Fetch -menu .mbar.fetch
1540.mbar add cascade -label Pull -menu .mbar.pull
8c0ce436 1541.mbar add cascade -label Push -menu .mbar.push
e534f3a8 1542.mbar add cascade -label Options -menu .mbar.options
cb07fc2a
SP
1543. configure -menu .mbar
1544
1545# -- Project Menu
1546menu .mbar.project
6f6eed28 1547.mbar.project add command -label Visualize \
cb07fc2a
SP
1548 -command do_gitk \
1549 -font $mainfont
d1536c48
SP
1550.mbar.project add command -label {Repack Database} \
1551 -command do_repack \
1552 -font $mainfont
cb07fc2a
SP
1553.mbar.project add command -label Quit \
1554 -command do_quit \
e210e674 1555 -accelerator $M1T-Q \
cb07fc2a
SP
1556 -font $mainfont
1557
9861671d
SP
1558# -- Edit Menu
1559#
1560menu .mbar.edit
1561.mbar.edit add command -label Undo \
1562 -command {catch {[focus] edit undo}} \
1563 -accelerator $M1T-Z \
1564 -font $mainfont
1565.mbar.edit add command -label Redo \
1566 -command {catch {[focus] edit redo}} \
1567 -accelerator $M1T-Y \
1568 -font $mainfont
1569.mbar.edit add separator
1570.mbar.edit add command -label Cut \
1571 -command {catch {tk_textCut [focus]}} \
1572 -accelerator $M1T-X \
1573 -font $mainfont
1574.mbar.edit add command -label Copy \
1575 -command {catch {tk_textCopy [focus]}} \
1576 -accelerator $M1T-C \
1577 -font $mainfont
1578.mbar.edit add command -label Paste \
1579 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1580 -accelerator $M1T-V \
1581 -font $mainfont
1582.mbar.edit add command -label Delete \
1583 -command {catch {[focus] delete sel.first sel.last}} \
1584 -accelerator Del \
1585 -font $mainfont
1586.mbar.edit add separator
1587.mbar.edit add command -label {Select All} \
1588 -command {catch {[focus] tag add sel 0.0 end}} \
1589 -accelerator $M1T-A \
1590 -font $mainfont
1591
cb07fc2a
SP
1592# -- Commit Menu
1593menu .mbar.commit
1594.mbar.commit add command -label Rescan \
1595 -command do_rescan \
e210e674 1596 -accelerator F5 \
cb07fc2a 1597 -font $mainfont
e210e674
SP
1598lappend disable_on_lock \
1599 [list .mbar.commit entryconf [.mbar.commit index last] -state]
e57ca85e
SP
1600.mbar.commit add command -label {Amend Last Commit} \
1601 -command do_amend_last \
1602 -font $mainfont
1603lappend disable_on_lock \
1604 [list .mbar.commit entryconf [.mbar.commit index last] -state]
7fe7e733
SP
1605.mbar.commit add command -label {Include All Files} \
1606 -command do_include_all \
49b86f01 1607 -accelerator $M1T-I \
131f503b 1608 -font $mainfont
e210e674
SP
1609lappend disable_on_lock \
1610 [list .mbar.commit entryconf [.mbar.commit index last] -state]
131f503b
SP
1611.mbar.commit add command -label {Sign Off} \
1612 -command do_signoff \
e210e674 1613 -accelerator $M1T-S \
131f503b
SP
1614 -font $mainfont
1615.mbar.commit add command -label Commit \
1616 -command do_commit \
e210e674 1617 -accelerator $M1T-Return \
131f503b 1618 -font $mainfont
e210e674
SP
1619lappend disable_on_lock \
1620 [list .mbar.commit entryconf [.mbar.commit index last] -state]
cb07fc2a
SP
1621
1622# -- Fetch Menu
1623menu .mbar.fetch
1624
1625# -- Pull Menu
1626menu .mbar.pull
1627
8c0ce436
SP
1628# -- Push Menu
1629menu .mbar.push
1630
e534f3a8
SP
1631# -- Options Menu
1632menu .mbar.options
9861671d
SP
1633.mbar.options add checkbutton \
1634 -label {Trust File Modification Timestamps} \
e534f3a8
SP
1635 -offvalue false \
1636 -onvalue true \
1637 -variable cfg_trust_mtime
1638
cb07fc2a
SP
1639# -- Main Window Layout
1640panedwindow .vpane -orient vertical
1641panedwindow .vpane.files -orient horizontal
6f6eed28 1642.vpane add .vpane.files -sticky nsew -height 100 -width 400
cb07fc2a
SP
1643pack .vpane -anchor n -side top -fill both -expand 1
1644
1645# -- Index File List
cb07fc2a
SP
1646frame .vpane.files.index -height 100 -width 400
1647label .vpane.files.index.title -text {Modified Files} \
1648 -background green \
1649 -font $mainfont
1650text $ui_index -background white -borderwidth 0 \
1651 -width 40 -height 10 \
1652 -font $mainfont \
1653 -yscrollcommand {.vpane.files.index.sb set} \
1654 -cursor $maincursor \
1655 -state disabled
1656scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1657pack .vpane.files.index.title -side top -fill x
1658pack .vpane.files.index.sb -side right -fill y
1659pack $ui_index -side left -fill both -expand 1
1660.vpane.files add .vpane.files.index -sticky nsew
1661
1662# -- Other (Add) File List
cb07fc2a
SP
1663frame .vpane.files.other -height 100 -width 100
1664label .vpane.files.other.title -text {Untracked Files} \
1665 -background red \
1666 -font $mainfont
1667text $ui_other -background white -borderwidth 0 \
1668 -width 40 -height 10 \
1669 -font $mainfont \
1670 -yscrollcommand {.vpane.files.other.sb set} \
1671 -cursor $maincursor \
1672 -state disabled
1673scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1674pack .vpane.files.other.title -side top -fill x
1675pack .vpane.files.other.sb -side right -fill y
1676pack $ui_other -side left -fill both -expand 1
1677.vpane.files add .vpane.files.other -sticky nsew
1678
131f503b
SP
1679$ui_index tag conf in_diff -font [concat $mainfont bold]
1680$ui_other tag conf in_diff -font [concat $mainfont bold]
1681
0fb8f9ce
SP
1682# -- Diff and Commit Area
1683frame .vpane.lower -height 400 -width 400
1684frame .vpane.lower.commarea
1685frame .vpane.lower.diff -relief sunken -borderwidth 1
1686pack .vpane.lower.commarea -side top -fill x
1687pack .vpane.lower.diff -side bottom -fill both -expand 1
1688.vpane add .vpane.lower -stick nsew
cb07fc2a
SP
1689
1690# -- Commit Area Buttons
0fb8f9ce
SP
1691frame .vpane.lower.commarea.buttons
1692label .vpane.lower.commarea.buttons.l -text {} \
cb07fc2a
SP
1693 -anchor w \
1694 -justify left \
1695 -font $mainfont
0fb8f9ce
SP
1696pack .vpane.lower.commarea.buttons.l -side top -fill x
1697pack .vpane.lower.commarea.buttons -side left -fill y
131f503b 1698
0fb8f9ce 1699button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
cb07fc2a
SP
1700 -command do_rescan \
1701 -font $mainfont
0fb8f9ce
SP
1702pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1703lappend disable_on_lock {.vpane.lower.commarea.buttons.rescan conf -state}
131f503b 1704
0fb8f9ce 1705button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
e57ca85e
SP
1706 -command do_amend_last \
1707 -font $mainfont
0fb8f9ce
SP
1708pack .vpane.lower.commarea.buttons.amend -side top -fill x
1709lappend disable_on_lock {.vpane.lower.commarea.buttons.amend conf -state}
e57ca85e 1710
7fe7e733
SP
1711button .vpane.lower.commarea.buttons.incall -text {Include All} \
1712 -command do_include_all \
cb07fc2a 1713 -font $mainfont
7fe7e733
SP
1714pack .vpane.lower.commarea.buttons.incall -side top -fill x
1715lappend disable_on_lock {.vpane.lower.commarea.buttons.incall conf -state}
131f503b 1716
0fb8f9ce 1717button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
131f503b
SP
1718 -command do_signoff \
1719 -font $mainfont
0fb8f9ce 1720pack .vpane.lower.commarea.buttons.signoff -side top -fill x
131f503b 1721
0fb8f9ce 1722button .vpane.lower.commarea.buttons.commit -text {Commit} \
cb07fc2a
SP
1723 -command do_commit \
1724 -font $mainfont
0fb8f9ce
SP
1725pack .vpane.lower.commarea.buttons.commit -side top -fill x
1726lappend disable_on_lock {.vpane.lower.commarea.buttons.commit conf -state}
cb07fc2a
SP
1727
1728# -- Commit Message Buffer
0fb8f9ce
SP
1729frame .vpane.lower.commarea.buffer
1730set ui_comm .vpane.lower.commarea.buffer.t
1731set ui_coml .vpane.lower.commarea.buffer.l
bd1e2b40 1732label $ui_coml -text {Commit Message:} \
cb07fc2a
SP
1733 -anchor w \
1734 -justify left \
1735 -font $mainfont
bd1e2b40
SP
1736trace add variable commit_type write {uplevel #0 {
1737 switch -glob $commit_type \
1738 initial {$ui_coml conf -text {Initial Commit Message:}} \
1739 amend {$ui_coml conf -text {Amended Commit Message:}} \
1740 merge {$ui_coml conf -text {Merge Commit Message:}} \
1741 * {$ui_coml conf -text {Commit Message:}}
1742}}
cb07fc2a 1743text $ui_comm -background white -borderwidth 1 \
9861671d 1744 -undo true \
b2c6fcf1 1745 -maxundo 20 \
9861671d 1746 -autoseparators true \
cb07fc2a 1747 -relief sunken \
0fb8f9ce 1748 -width 75 -height 9 -wrap none \
cb07fc2a 1749 -font $difffont \
0fb8f9ce 1750 -yscrollcommand {.vpane.lower.commarea.buffer.sby set} \
cb07fc2a 1751 -cursor $maincursor
0fb8f9ce 1752scrollbar .vpane.lower.commarea.buffer.sby -command [list $ui_comm yview]
bd1e2b40 1753pack $ui_coml -side top -fill x
0fb8f9ce 1754pack .vpane.lower.commarea.buffer.sby -side right -fill y
cb07fc2a 1755pack $ui_comm -side left -fill y
0fb8f9ce
SP
1756pack .vpane.lower.commarea.buffer -side left -fill y
1757
1758# -- Diff Header
1759set ui_fname_value {}
1760set ui_fstatus_value {}
1761frame .vpane.lower.diff.header -background orange
1762label .vpane.lower.diff.header.l1 -text {File:} \
1763 -background orange \
1764 -font $mainfont
1765label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1766 -background orange \
1767 -anchor w \
1768 -justify left \
1769 -font $mainfont
1770label .vpane.lower.diff.header.l3 -text {Status:} \
1771 -background orange \
1772 -font $mainfont
1773label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
1774 -background orange \
1775 -width $max_status_desc \
1776 -anchor w \
1777 -justify left \
1778 -font $mainfont
1779pack .vpane.lower.diff.header.l1 -side left
1780pack .vpane.lower.diff.header.l2 -side left -fill x
1781pack .vpane.lower.diff.header.l4 -side right
1782pack .vpane.lower.diff.header.l3 -side right
1783
1784# -- Diff Body
1785frame .vpane.lower.diff.body
1786set ui_diff .vpane.lower.diff.body.t
1787text $ui_diff -background white -borderwidth 0 \
1788 -width 80 -height 15 -wrap none \
1789 -font $difffont \
1790 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1791 -yscrollcommand {.vpane.lower.diff.body.sby set} \
1792 -cursor $maincursor \
1793 -state disabled
1794scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1795 -command [list $ui_diff xview]
1796scrollbar .vpane.lower.diff.body.sby -orient vertical \
1797 -command [list $ui_diff yview]
1798pack .vpane.lower.diff.body.sbx -side bottom -fill x
1799pack .vpane.lower.diff.body.sby -side right -fill y
1800pack $ui_diff -side left -fill both -expand 1
1801pack .vpane.lower.diff.header -side top -fill x
1802pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1803
1804$ui_diff tag conf dm -foreground red
1805$ui_diff tag conf dp -foreground blue
1806$ui_diff tag conf da -font [concat $difffont bold]
1807$ui_diff tag conf di -foreground "#00a000"
1808$ui_diff tag conf dni -foreground "#a000a0"
1809$ui_diff tag conf bold -font [concat $difffont bold]
cb07fc2a
SP
1810
1811# -- Status Bar
1812set ui_status_value {Initializing...}
1813label .status -textvariable ui_status_value \
1814 -anchor w \
1815 -justify left \
1816 -borderwidth 1 \
1817 -relief sunken \
1818 -font $mainfont
1819pack .status -anchor w -side bottom -fill x
1820
2d19516d
SP
1821# -- Load geometry
1822catch {
1823wm geometry . [lindex $repo_config(gui.geometry) 0 0]
1824eval .vpane sash place 0 [lindex $repo_config(gui.geometry) 0 1]
1825eval .vpane.files sash place 0 [lindex $repo_config(gui.geometry) 0 2]
1826}
1827
cb07fc2a 1828# -- Key Bindings
ec6b424a 1829bind $ui_comm <$M1B-Key-Return> {do_commit;break}
49b86f01
SP
1830bind $ui_comm <$M1B-Key-i> {do_include_all;break}
1831bind $ui_comm <$M1B-Key-I> {do_include_all;break}
9861671d
SP
1832bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
1833bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
1834bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
1835bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
1836bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
1837bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
1838bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
1839bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
1840
1841bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
1842bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
1843bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
1844bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
1845bind $ui_diff <$M1B-Key-v> {break}
1846bind $ui_diff <$M1B-Key-V> {break}
1847bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
1848bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
b2c6fcf1
SP
1849bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
1850bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
1851bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
1852bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
49b86f01 1853
07123f40
SP
1854bind . <Destroy> do_quit
1855bind all <Key-F5> do_rescan
1856bind all <$M1B-Key-r> do_rescan
1857bind all <$M1B-Key-R> do_rescan
1858bind . <$M1B-Key-s> do_signoff
1859bind . <$M1B-Key-S> do_signoff
49b86f01
SP
1860bind . <$M1B-Key-i> do_include_all
1861bind . <$M1B-Key-I> do_include_all
07123f40
SP
1862bind . <$M1B-Key-Return> do_commit
1863bind all <$M1B-Key-q> do_quit
1864bind all <$M1B-Key-Q> do_quit
1865bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1866bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
cb07fc2a
SP
1867foreach i [list $ui_index $ui_other] {
1868 bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1869 bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1870 bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1871}
e210e674 1872unset i M1B M1T
cb07fc2a 1873
ec6b424a 1874wm title . "$appname ([file normalize [file dirname $gitdir]])"
cb07fc2a 1875focus -force $ui_comm
8c0ce436
SP
1876load_all_remotes
1877populate_remote_menu .mbar.fetch From fetch_from
1878populate_remote_menu .mbar.push To push_to
d33ba5fa 1879populate_pull_menu .mbar.pull
cb07fc2a 1880update_status