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