Merge branch 'maint'
[git/git.git] / git-gui.sh
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 || test "z$*" = z--version; \
5 then \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
7 exit; \
8 fi; \
9 exec wish "$0" -- "$@"
10
11 set appvers {@@GITGUI_VERSION@@}
12 set copyright {
13 Copyright © 2006, 2007 Shawn Pearce, et. al.
14
15 This program is free software; you can redistribute it and/or modify
16 it under the terms of the GNU General Public License as published by
17 the Free Software Foundation; either version 2 of the License, or
18 (at your option) any later version.
19
20 This program is distributed in the hope that it will be useful,
21 but WITHOUT ANY WARRANTY; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 GNU General Public License for more details.
24
25 You should have received a copy of the GNU General Public License
26 along with this program; if not, write to the Free Software
27 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
28
29 ######################################################################
30 ##
31 ## Tcl/Tk sanity check
32
33 if {[catch {package require Tcl 8.4} err]
34 || [catch {package require Tk 8.4} err]
35 } {
36 catch {wm withdraw .}
37 tk_messageBox \
38 -icon error \
39 -type ok \
40 -title "git-gui: fatal error" \
41 -message $err
42 exit 1
43 }
44
45 ######################################################################
46 ##
47 ## locate our library
48
49 set oguilib {@@GITGUI_LIBDIR@@}
50 set oguirel {@@GITGUI_RELATIVE@@}
51 if {$oguirel eq {1}} {
52 set oguilib [file dirname [file dirname [file normalize $argv0]]]
53 set oguilib [file join $oguilib share git-gui lib]
54 set oguimsg [file join $oguilib msgs]
55 } elseif {[string match @@* $oguirel]} {
56 set oguilib [file join [file dirname [file normalize $argv0]] lib]
57 set oguimsg [file join [file dirname [file normalize $argv0]] po]
58 } else {
59 set oguimsg [file join $oguilib msgs]
60 }
61 unset oguirel
62
63 ######################################################################
64 ##
65 ## enable verbose loading?
66
67 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
68 unset _verbose
69 rename auto_load real__auto_load
70 proc auto_load {name args} {
71 puts stderr "auto_load $name"
72 return [uplevel 1 real__auto_load $name $args]
73 }
74 rename source real__source
75 proc source {name} {
76 puts stderr "source $name"
77 uplevel 1 real__source $name
78 }
79 }
80
81 ######################################################################
82 ##
83 ## Internationalization (i18n) through msgcat and gettext. See
84 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
85
86 package require msgcat
87 namespace import ::msgcat::mc
88 ::msgcat::mcload $oguimsg
89 unset oguimsg
90
91 ######################################################################
92 ##
93 ## read only globals
94
95 set _appname [lindex [file split $argv0] end]
96 set _gitdir {}
97 set _gitexec {}
98 set _reponame {}
99 set _iscygwin {}
100 set _search_path {}
101
102 proc appname {} {
103 global _appname
104 return $_appname
105 }
106
107 proc gitdir {args} {
108 global _gitdir
109 if {$args eq {}} {
110 return $_gitdir
111 }
112 return [eval [list file join $_gitdir] $args]
113 }
114
115 proc gitexec {args} {
116 global _gitexec
117 if {$_gitexec eq {}} {
118 if {[catch {set _gitexec [git --exec-path]} err]} {
119 error "Git not installed?\n\n$err"
120 }
121 if {[is_Cygwin]} {
122 set _gitexec [exec cygpath \
123 --windows \
124 --absolute \
125 $_gitexec]
126 } else {
127 set _gitexec [file normalize $_gitexec]
128 }
129 }
130 if {$args eq {}} {
131 return $_gitexec
132 }
133 return [eval [list file join $_gitexec] $args]
134 }
135
136 proc reponame {} {
137 return $::_reponame
138 }
139
140 proc is_MacOSX {} {
141 if {[tk windowingsystem] eq {aqua}} {
142 return 1
143 }
144 return 0
145 }
146
147 proc is_Windows {} {
148 if {$::tcl_platform(platform) eq {windows}} {
149 return 1
150 }
151 return 0
152 }
153
154 proc is_Cygwin {} {
155 global _iscygwin
156 if {$_iscygwin eq {}} {
157 if {$::tcl_platform(platform) eq {windows}} {
158 if {[catch {set p [exec cygpath --windir]} err]} {
159 set _iscygwin 0
160 } else {
161 set _iscygwin 1
162 }
163 } else {
164 set _iscygwin 0
165 }
166 }
167 return $_iscygwin
168 }
169
170 proc is_enabled {option} {
171 global enabled_options
172 if {[catch {set on $enabled_options($option)}]} {return 0}
173 return $on
174 }
175
176 proc enable_option {option} {
177 global enabled_options
178 set enabled_options($option) 1
179 }
180
181 proc disable_option {option} {
182 global enabled_options
183 set enabled_options($option) 0
184 }
185
186 ######################################################################
187 ##
188 ## config
189
190 proc is_many_config {name} {
191 switch -glob -- $name {
192 remote.*.fetch -
193 remote.*.push
194 {return 1}
195 *
196 {return 0}
197 }
198 }
199
200 proc is_config_true {name} {
201 global repo_config
202 if {[catch {set v $repo_config($name)}]} {
203 return 0
204 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
205 return 1
206 } else {
207 return 0
208 }
209 }
210
211 proc get_config {name} {
212 global repo_config
213 if {[catch {set v $repo_config($name)}]} {
214 return {}
215 } else {
216 return $v
217 }
218 }
219
220 proc load_config {include_global} {
221 global repo_config global_config default_config
222
223 array unset global_config
224 if {$include_global} {
225 catch {
226 set fd_rc [git_read config --global --list]
227 while {[gets $fd_rc line] >= 0} {
228 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
229 if {[is_many_config $name]} {
230 lappend global_config($name) $value
231 } else {
232 set global_config($name) $value
233 }
234 }
235 }
236 close $fd_rc
237 }
238 }
239
240 array unset repo_config
241 catch {
242 set fd_rc [git_read config --list]
243 while {[gets $fd_rc line] >= 0} {
244 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
245 if {[is_many_config $name]} {
246 lappend repo_config($name) $value
247 } else {
248 set repo_config($name) $value
249 }
250 }
251 }
252 close $fd_rc
253 }
254
255 foreach name [array names default_config] {
256 if {[catch {set v $global_config($name)}]} {
257 set global_config($name) $default_config($name)
258 }
259 if {[catch {set v $repo_config($name)}]} {
260 set repo_config($name) $default_config($name)
261 }
262 }
263 }
264
265 ######################################################################
266 ##
267 ## handy utils
268
269 proc _git_cmd {name} {
270 global _git_cmd_path
271
272 if {[catch {set v $_git_cmd_path($name)}]} {
273 switch -- $name {
274 version -
275 --version -
276 --exec-path { return [list $::_git $name] }
277 }
278
279 set p [gitexec git-$name$::_search_exe]
280 if {[file exists $p]} {
281 set v [list $p]
282 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
283 # Try to determine what sort of magic will make
284 # git-$name go and do its thing, because native
285 # Tcl on Windows doesn't know it.
286 #
287 set p [gitexec git-$name]
288 set f [open $p r]
289 set s [gets $f]
290 close $f
291
292 switch -glob -- [lindex $s 0] {
293 #!*sh { set i sh }
294 #!*perl { set i perl }
295 #!*python { set i python }
296 default { error "git-$name is not supported: $s" }
297 }
298
299 upvar #0 _$i interp
300 if {![info exists interp]} {
301 set interp [_which $i]
302 }
303 if {$interp eq {}} {
304 error "git-$name requires $i (not in PATH)"
305 }
306 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
307 } else {
308 # Assume it is builtin to git somehow and we
309 # aren't actually able to see a file for it.
310 #
311 set v [list $::_git $name]
312 }
313 set _git_cmd_path($name) $v
314 }
315 return $v
316 }
317
318 proc _which {what} {
319 global env _search_exe _search_path
320
321 if {$_search_path eq {}} {
322 if {[is_Cygwin]} {
323 set _search_path [split [exec cygpath \
324 --windows \
325 --path \
326 --absolute \
327 $env(PATH)] {;}]
328 set _search_exe .exe
329 } elseif {[is_Windows]} {
330 set _search_path [split $env(PATH) {;}]
331 set _search_exe .exe
332 } else {
333 set _search_path [split $env(PATH) :]
334 set _search_exe {}
335 }
336 }
337
338 foreach p $_search_path {
339 set p [file join $p $what$_search_exe]
340 if {[file exists $p]} {
341 return [file normalize $p]
342 }
343 }
344 return {}
345 }
346
347 proc _lappend_nice {cmd_var} {
348 global _nice
349 upvar $cmd_var cmd
350
351 if {![info exists _nice]} {
352 set _nice [_which nice]
353 }
354 if {$_nice ne {}} {
355 lappend cmd $_nice
356 }
357 }
358
359 proc git {args} {
360 set opt [list exec]
361
362 while {1} {
363 switch -- [lindex $args 0] {
364 --nice {
365 _lappend_nice opt
366 }
367
368 default {
369 break
370 }
371
372 }
373
374 set args [lrange $args 1 end]
375 }
376
377 set cmdp [_git_cmd [lindex $args 0]]
378 set args [lrange $args 1 end]
379
380 return [eval $opt $cmdp $args]
381 }
382
383 proc _open_stdout_stderr {cmd} {
384 if {[catch {
385 set fd [open $cmd r]
386 } err]} {
387 if { [lindex $cmd end] eq {2>@1}
388 && $err eq {can not find channel named "1"}
389 } {
390 # Older versions of Tcl 8.4 don't have this 2>@1 IO
391 # redirect operator. Fallback to |& cat for those.
392 # The command was not actually started, so its safe
393 # to try to start it a second time.
394 #
395 set fd [open [concat \
396 [lrange $cmd 0 end-1] \
397 [list |& cat] \
398 ] r]
399 } else {
400 error $err
401 }
402 }
403 fconfigure $fd -eofchar {}
404 return $fd
405 }
406
407 proc git_read {args} {
408 set opt [list |]
409
410 while {1} {
411 switch -- [lindex $args 0] {
412 --nice {
413 _lappend_nice opt
414 }
415
416 --stderr {
417 lappend args 2>@1
418 }
419
420 default {
421 break
422 }
423
424 }
425
426 set args [lrange $args 1 end]
427 }
428
429 set cmdp [_git_cmd [lindex $args 0]]
430 set args [lrange $args 1 end]
431
432 return [_open_stdout_stderr [concat $opt $cmdp $args]]
433 }
434
435 proc git_write {args} {
436 set opt [list |]
437
438 while {1} {
439 switch -- [lindex $args 0] {
440 --nice {
441 _lappend_nice opt
442 }
443
444 default {
445 break
446 }
447
448 }
449
450 set args [lrange $args 1 end]
451 }
452
453 set cmdp [_git_cmd [lindex $args 0]]
454 set args [lrange $args 1 end]
455
456 return [open [concat $opt $cmdp $args] w]
457 }
458
459 proc sq {value} {
460 regsub -all ' $value "'\\''" value
461 return "'$value'"
462 }
463
464 proc load_current_branch {} {
465 global current_branch is_detached
466
467 set fd [open [gitdir HEAD] r]
468 if {[gets $fd ref] < 1} {
469 set ref {}
470 }
471 close $fd
472
473 set pfx {ref: refs/heads/}
474 set len [string length $pfx]
475 if {[string equal -length $len $pfx $ref]} {
476 # We're on a branch. It might not exist. But
477 # HEAD looks good enough to be a branch.
478 #
479 set current_branch [string range $ref $len end]
480 set is_detached 0
481 } else {
482 # Assume this is a detached head.
483 #
484 set current_branch HEAD
485 set is_detached 1
486 }
487 }
488
489 auto_load tk_optionMenu
490 rename tk_optionMenu real__tkOptionMenu
491 proc tk_optionMenu {w varName args} {
492 set m [eval real__tkOptionMenu $w $varName $args]
493 $m configure -font font_ui
494 $w configure -font font_ui
495 return $m
496 }
497
498 ######################################################################
499 ##
500 ## find git
501
502 set _git [_which git]
503 if {$_git eq {}} {
504 catch {wm withdraw .}
505 error_popup [mc "Cannot find git in PATH."]
506 exit 1
507 }
508
509 ######################################################################
510 ##
511 ## version check
512
513 if {[catch {set _git_version [git --version]} err]} {
514 catch {wm withdraw .}
515 tk_messageBox \
516 -icon error \
517 -type ok \
518 -title "git-gui: fatal error" \
519 -message "Cannot determine Git version:
520
521 $err
522
523 [appname] requires Git 1.5.0 or later."
524 exit 1
525 }
526 if {![regsub {^git version } $_git_version {} _git_version]} {
527 catch {wm withdraw .}
528 tk_messageBox \
529 -icon error \
530 -type ok \
531 -title "git-gui: fatal error" \
532 -message [append [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
533 exit 1
534 }
535
536 set _real_git_version $_git_version
537 regsub -- {-dirty$} $_git_version {} _git_version
538 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
539 regsub {\.rc[0-9]+$} $_git_version {} _git_version
540 regsub {\.GIT$} $_git_version {} _git_version
541
542 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
543 catch {wm withdraw .}
544 if {[tk_messageBox \
545 -icon warning \
546 -type yesno \
547 -default no \
548 -title "[appname]: warning" \
549 -message [mc "Git version cannot be determined.
550
551 %s claims it is version '%s'.
552
553 %s requires at least Git 1.5.0 or later.
554
555 Assume '%s' is version 1.5.0?
556 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
557 set _git_version 1.5.0
558 } else {
559 exit 1
560 }
561 }
562 unset _real_git_version
563
564 proc git-version {args} {
565 global _git_version
566
567 switch [llength $args] {
568 0 {
569 return $_git_version
570 }
571
572 2 {
573 set op [lindex $args 0]
574 set vr [lindex $args 1]
575 set cm [package vcompare $_git_version $vr]
576 return [expr $cm $op 0]
577 }
578
579 4 {
580 set type [lindex $args 0]
581 set name [lindex $args 1]
582 set parm [lindex $args 2]
583 set body [lindex $args 3]
584
585 if {($type ne {proc} && $type ne {method})} {
586 error "Invalid arguments to git-version"
587 }
588 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
589 error "Last arm of $type $name must be default"
590 }
591
592 foreach {op vr cb} [lrange $body 0 end-2] {
593 if {[git-version $op $vr]} {
594 return [uplevel [list $type $name $parm $cb]]
595 }
596 }
597
598 return [uplevel [list $type $name $parm [lindex $body end]]]
599 }
600
601 default {
602 error "git-version >= x"
603 }
604
605 }
606 }
607
608 if {[git-version < 1.5]} {
609 catch {wm withdraw .}
610 tk_messageBox \
611 -icon error \
612 -type ok \
613 -title "git-gui: fatal error" \
614 -message "[appname] requires Git 1.5.0 or later.
615
616 You are using [git-version]:
617
618 [git --version]"
619 exit 1
620 }
621
622 ######################################################################
623 ##
624 ## configure our library
625
626 set idx [file join $oguilib tclIndex]
627 if {[catch {set fd [open $idx r]} err]} {
628 catch {wm withdraw .}
629 tk_messageBox \
630 -icon error \
631 -type ok \
632 -title "git-gui: fatal error" \
633 -message $err
634 exit 1
635 }
636 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
637 set idx [list]
638 while {[gets $fd n] >= 0} {
639 if {$n ne {} && ![string match #* $n]} {
640 lappend idx $n
641 }
642 }
643 } else {
644 set idx {}
645 }
646 close $fd
647
648 if {$idx ne {}} {
649 set loaded [list]
650 foreach p $idx {
651 if {[lsearch -exact $loaded $p] >= 0} continue
652 source [file join $oguilib $p]
653 lappend loaded $p
654 }
655 unset loaded p
656 } else {
657 set auto_path [concat [list $oguilib] $auto_path]
658 }
659 unset -nocomplain idx fd
660
661 ######################################################################
662 ##
663 ## feature option selection
664
665 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
666 unset _junk
667 } else {
668 set subcommand gui
669 }
670 if {$subcommand eq {gui.sh}} {
671 set subcommand gui
672 }
673 if {$subcommand eq {gui} && [llength $argv] > 0} {
674 set subcommand [lindex $argv 0]
675 set argv [lrange $argv 1 end]
676 }
677
678 enable_option multicommit
679 enable_option branch
680 enable_option transport
681 disable_option bare
682
683 switch -- $subcommand {
684 browser -
685 blame {
686 enable_option bare
687
688 disable_option multicommit
689 disable_option branch
690 disable_option transport
691 }
692 citool {
693 enable_option singlecommit
694
695 disable_option multicommit
696 disable_option branch
697 disable_option transport
698 }
699 }
700
701 ######################################################################
702 ##
703 ## repository setup
704
705 if {[catch {
706 set _gitdir $env(GIT_DIR)
707 set _prefix {}
708 }]
709 && [catch {
710 set _gitdir [git rev-parse --git-dir]
711 set _prefix [git rev-parse --show-prefix]
712 } err]} {
713 catch {wm withdraw .}
714 error_popup [append [mc "Cannot find the git directory:"] "\n\n$err"]
715 exit 1
716 }
717 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
718 catch {set _gitdir [exec cygpath --unix $_gitdir]}
719 }
720 if {![file isdirectory $_gitdir]} {
721 catch {wm withdraw .}
722 error_popup [append [mc "Git directory not found:"] "\n\n$_gitdir"]
723 exit 1
724 }
725 if {$_prefix ne {}} {
726 regsub -all {[^/]+/} $_prefix ../ cdup
727 if {[catch {cd $cdup} err]} {
728 catch {wm withdraw .}
729 error_popup "Cannot move to top of working directory:\n\n$err"
730 exit 1
731 }
732 unset cdup
733 } elseif {![is_enabled bare]} {
734 if {[lindex [file split $_gitdir] end] ne {.git}} {
735 catch {wm withdraw .}
736 error_popup [append [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
737 exit 1
738 }
739 if {[catch {cd [file dirname $_gitdir]} err]} {
740 catch {wm withdraw .}
741 error_popup [append [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
742 exit 1
743 }
744 }
745 set _reponame [file split [file normalize $_gitdir]]
746 if {[lindex $_reponame end] eq {.git}} {
747 set _reponame [lindex $_reponame end-1]
748 } else {
749 set _reponame [lindex $_reponame end]
750 }
751
752 ######################################################################
753 ##
754 ## global init
755
756 set current_diff_path {}
757 set current_diff_side {}
758 set diff_actions [list]
759
760 set HEAD {}
761 set PARENT {}
762 set MERGE_HEAD [list]
763 set commit_type {}
764 set empty_tree {}
765 set current_branch {}
766 set is_detached 0
767 set current_diff_path {}
768 set is_3way_diff 0
769 set selected_commit_type new
770
771 ######################################################################
772 ##
773 ## task management
774
775 set rescan_active 0
776 set diff_active 0
777 set last_clicked {}
778
779 set disable_on_lock [list]
780 set index_lock_type none
781
782 proc lock_index {type} {
783 global index_lock_type disable_on_lock
784
785 if {$index_lock_type eq {none}} {
786 set index_lock_type $type
787 foreach w $disable_on_lock {
788 uplevel #0 $w disabled
789 }
790 return 1
791 } elseif {$index_lock_type eq "begin-$type"} {
792 set index_lock_type $type
793 return 1
794 }
795 return 0
796 }
797
798 proc unlock_index {} {
799 global index_lock_type disable_on_lock
800
801 set index_lock_type none
802 foreach w $disable_on_lock {
803 uplevel #0 $w normal
804 }
805 }
806
807 ######################################################################
808 ##
809 ## status
810
811 proc repository_state {ctvar hdvar mhvar} {
812 global current_branch
813 upvar $ctvar ct $hdvar hd $mhvar mh
814
815 set mh [list]
816
817 load_current_branch
818 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
819 set hd {}
820 set ct initial
821 return
822 }
823
824 set merge_head [gitdir MERGE_HEAD]
825 if {[file exists $merge_head]} {
826 set ct merge
827 set fd_mh [open $merge_head r]
828 while {[gets $fd_mh line] >= 0} {
829 lappend mh $line
830 }
831 close $fd_mh
832 return
833 }
834
835 set ct normal
836 }
837
838 proc PARENT {} {
839 global PARENT empty_tree
840
841 set p [lindex $PARENT 0]
842 if {$p ne {}} {
843 return $p
844 }
845 if {$empty_tree eq {}} {
846 set empty_tree [git mktree << {}]
847 }
848 return $empty_tree
849 }
850
851 proc rescan {after {honor_trustmtime 1}} {
852 global HEAD PARENT MERGE_HEAD commit_type
853 global ui_index ui_workdir ui_comm
854 global rescan_active file_states
855 global repo_config
856
857 if {$rescan_active > 0 || ![lock_index read]} return
858
859 repository_state newType newHEAD newMERGE_HEAD
860 if {[string match amend* $commit_type]
861 && $newType eq {normal}
862 && $newHEAD eq $HEAD} {
863 } else {
864 set HEAD $newHEAD
865 set PARENT $newHEAD
866 set MERGE_HEAD $newMERGE_HEAD
867 set commit_type $newType
868 }
869
870 array unset file_states
871
872 if {!$::GITGUI_BCK_exists &&
873 (![$ui_comm edit modified]
874 || [string trim [$ui_comm get 0.0 end]] eq {})} {
875 if {[string match amend* $commit_type]} {
876 } elseif {[load_message GITGUI_MSG]} {
877 } elseif {[load_message MERGE_MSG]} {
878 } elseif {[load_message SQUASH_MSG]} {
879 }
880 $ui_comm edit reset
881 $ui_comm edit modified false
882 }
883
884 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
885 rescan_stage2 {} $after
886 } else {
887 set rescan_active 1
888 ui_status [mc "Refreshing file status..."]
889 set fd_rf [git_read update-index \
890 -q \
891 --unmerged \
892 --ignore-missing \
893 --refresh \
894 ]
895 fconfigure $fd_rf -blocking 0 -translation binary
896 fileevent $fd_rf readable \
897 [list rescan_stage2 $fd_rf $after]
898 }
899 }
900
901 proc rescan_stage2 {fd after} {
902 global rescan_active buf_rdi buf_rdf buf_rlo
903
904 if {$fd ne {}} {
905 read $fd
906 if {![eof $fd]} return
907 close $fd
908 }
909
910 set ls_others [list --exclude-per-directory=.gitignore]
911 set info_exclude [gitdir info exclude]
912 if {[file readable $info_exclude]} {
913 lappend ls_others "--exclude-from=$info_exclude"
914 }
915 set user_exclude [get_config core.excludesfile]
916 if {$user_exclude ne {} && [file readable $user_exclude]} {
917 lappend ls_others "--exclude-from=$user_exclude"
918 }
919
920 set buf_rdi {}
921 set buf_rdf {}
922 set buf_rlo {}
923
924 set rescan_active 3
925 ui_status [mc "Scanning for modified files ..."]
926 set fd_di [git_read diff-index --cached -z [PARENT]]
927 set fd_df [git_read diff-files -z]
928 set fd_lo [eval git_read ls-files --others -z $ls_others]
929
930 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
931 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
932 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
933 fileevent $fd_di readable [list read_diff_index $fd_di $after]
934 fileevent $fd_df readable [list read_diff_files $fd_df $after]
935 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
936 }
937
938 proc load_message {file} {
939 global ui_comm
940
941 set f [gitdir $file]
942 if {[file isfile $f]} {
943 if {[catch {set fd [open $f r]}]} {
944 return 0
945 }
946 fconfigure $fd -eofchar {}
947 set content [string trim [read $fd]]
948 close $fd
949 regsub -all -line {[ \r\t]+$} $content {} content
950 $ui_comm delete 0.0 end
951 $ui_comm insert end $content
952 return 1
953 }
954 return 0
955 }
956
957 proc read_diff_index {fd after} {
958 global buf_rdi
959
960 append buf_rdi [read $fd]
961 set c 0
962 set n [string length $buf_rdi]
963 while {$c < $n} {
964 set z1 [string first "\0" $buf_rdi $c]
965 if {$z1 == -1} break
966 incr z1
967 set z2 [string first "\0" $buf_rdi $z1]
968 if {$z2 == -1} break
969
970 incr c
971 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
972 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
973 merge_state \
974 [encoding convertfrom $p] \
975 [lindex $i 4]? \
976 [list [lindex $i 0] [lindex $i 2]] \
977 [list]
978 set c $z2
979 incr c
980 }
981 if {$c < $n} {
982 set buf_rdi [string range $buf_rdi $c end]
983 } else {
984 set buf_rdi {}
985 }
986
987 rescan_done $fd buf_rdi $after
988 }
989
990 proc read_diff_files {fd after} {
991 global buf_rdf
992
993 append buf_rdf [read $fd]
994 set c 0
995 set n [string length $buf_rdf]
996 while {$c < $n} {
997 set z1 [string first "\0" $buf_rdf $c]
998 if {$z1 == -1} break
999 incr z1
1000 set z2 [string first "\0" $buf_rdf $z1]
1001 if {$z2 == -1} break
1002
1003 incr c
1004 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1005 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1006 merge_state \
1007 [encoding convertfrom $p] \
1008 ?[lindex $i 4] \
1009 [list] \
1010 [list [lindex $i 0] [lindex $i 2]]
1011 set c $z2
1012 incr c
1013 }
1014 if {$c < $n} {
1015 set buf_rdf [string range $buf_rdf $c end]
1016 } else {
1017 set buf_rdf {}
1018 }
1019
1020 rescan_done $fd buf_rdf $after
1021 }
1022
1023 proc read_ls_others {fd after} {
1024 global buf_rlo
1025
1026 append buf_rlo [read $fd]
1027 set pck [split $buf_rlo "\0"]
1028 set buf_rlo [lindex $pck end]
1029 foreach p [lrange $pck 0 end-1] {
1030 merge_state [encoding convertfrom $p] ?O
1031 }
1032 rescan_done $fd buf_rlo $after
1033 }
1034
1035 proc rescan_done {fd buf after} {
1036 global rescan_active current_diff_path
1037 global file_states repo_config
1038 upvar $buf to_clear
1039
1040 if {![eof $fd]} return
1041 set to_clear {}
1042 close $fd
1043 if {[incr rescan_active -1] > 0} return
1044
1045 prune_selection
1046 unlock_index
1047 display_all_files
1048 if {$current_diff_path ne {}} reshow_diff
1049 uplevel #0 $after
1050 }
1051
1052 proc prune_selection {} {
1053 global file_states selected_paths
1054
1055 foreach path [array names selected_paths] {
1056 if {[catch {set still_here $file_states($path)}]} {
1057 unset selected_paths($path)
1058 }
1059 }
1060 }
1061
1062 ######################################################################
1063 ##
1064 ## ui helpers
1065
1066 proc mapicon {w state path} {
1067 global all_icons
1068
1069 if {[catch {set r $all_icons($state$w)}]} {
1070 puts "error: no icon for $w state={$state} $path"
1071 return file_plain
1072 }
1073 return $r
1074 }
1075
1076 proc mapdesc {state path} {
1077 global all_descs
1078
1079 if {[catch {set r $all_descs($state)}]} {
1080 puts "error: no desc for state={$state} $path"
1081 return $state
1082 }
1083 return $r
1084 }
1085
1086 proc ui_status {msg} {
1087 $::main_status show $msg
1088 }
1089
1090 proc ui_ready {{test {}}} {
1091 $::main_status show [mc "Ready."] $test
1092 }
1093
1094 proc escape_path {path} {
1095 regsub -all {\\} $path "\\\\" path
1096 regsub -all "\n" $path "\\n" path
1097 return $path
1098 }
1099
1100 proc short_path {path} {
1101 return [escape_path [lindex [file split $path] end]]
1102 }
1103
1104 set next_icon_id 0
1105 set null_sha1 [string repeat 0 40]
1106
1107 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1108 global file_states next_icon_id null_sha1
1109
1110 set s0 [string index $new_state 0]
1111 set s1 [string index $new_state 1]
1112
1113 if {[catch {set info $file_states($path)}]} {
1114 set state __
1115 set icon n[incr next_icon_id]
1116 } else {
1117 set state [lindex $info 0]
1118 set icon [lindex $info 1]
1119 if {$head_info eq {}} {set head_info [lindex $info 2]}
1120 if {$index_info eq {}} {set index_info [lindex $info 3]}
1121 }
1122
1123 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1124 elseif {$s0 eq {_}} {set s0 _}
1125
1126 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1127 elseif {$s1 eq {_}} {set s1 _}
1128
1129 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1130 set head_info [list 0 $null_sha1]
1131 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1132 && $head_info eq {}} {
1133 set head_info $index_info
1134 }
1135
1136 set file_states($path) [list $s0$s1 $icon \
1137 $head_info $index_info \
1138 ]
1139 return $state
1140 }
1141
1142 proc display_file_helper {w path icon_name old_m new_m} {
1143 global file_lists
1144
1145 if {$new_m eq {_}} {
1146 set lno [lsearch -sorted -exact $file_lists($w) $path]
1147 if {$lno >= 0} {
1148 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1149 incr lno
1150 $w conf -state normal
1151 $w delete $lno.0 [expr {$lno + 1}].0
1152 $w conf -state disabled
1153 }
1154 } elseif {$old_m eq {_} && $new_m ne {_}} {
1155 lappend file_lists($w) $path
1156 set file_lists($w) [lsort -unique $file_lists($w)]
1157 set lno [lsearch -sorted -exact $file_lists($w) $path]
1158 incr lno
1159 $w conf -state normal
1160 $w image create $lno.0 \
1161 -align center -padx 5 -pady 1 \
1162 -name $icon_name \
1163 -image [mapicon $w $new_m $path]
1164 $w insert $lno.1 "[escape_path $path]\n"
1165 $w conf -state disabled
1166 } elseif {$old_m ne $new_m} {
1167 $w conf -state normal
1168 $w image conf $icon_name -image [mapicon $w $new_m $path]
1169 $w conf -state disabled
1170 }
1171 }
1172
1173 proc display_file {path state} {
1174 global file_states selected_paths
1175 global ui_index ui_workdir
1176
1177 set old_m [merge_state $path $state]
1178 set s $file_states($path)
1179 set new_m [lindex $s 0]
1180 set icon_name [lindex $s 1]
1181
1182 set o [string index $old_m 0]
1183 set n [string index $new_m 0]
1184 if {$o eq {U}} {
1185 set o _
1186 }
1187 if {$n eq {U}} {
1188 set n _
1189 }
1190 display_file_helper $ui_index $path $icon_name $o $n
1191
1192 if {[string index $old_m 0] eq {U}} {
1193 set o U
1194 } else {
1195 set o [string index $old_m 1]
1196 }
1197 if {[string index $new_m 0] eq {U}} {
1198 set n U
1199 } else {
1200 set n [string index $new_m 1]
1201 }
1202 display_file_helper $ui_workdir $path $icon_name $o $n
1203
1204 if {$new_m eq {__}} {
1205 unset file_states($path)
1206 catch {unset selected_paths($path)}
1207 }
1208 }
1209
1210 proc display_all_files_helper {w path icon_name m} {
1211 global file_lists
1212
1213 lappend file_lists($w) $path
1214 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1215 $w image create end \
1216 -align center -padx 5 -pady 1 \
1217 -name $icon_name \
1218 -image [mapicon $w $m $path]
1219 $w insert end "[escape_path $path]\n"
1220 }
1221
1222 proc display_all_files {} {
1223 global ui_index ui_workdir
1224 global file_states file_lists
1225 global last_clicked
1226
1227 $ui_index conf -state normal
1228 $ui_workdir conf -state normal
1229
1230 $ui_index delete 0.0 end
1231 $ui_workdir delete 0.0 end
1232 set last_clicked {}
1233
1234 set file_lists($ui_index) [list]
1235 set file_lists($ui_workdir) [list]
1236
1237 foreach path [lsort [array names file_states]] {
1238 set s $file_states($path)
1239 set m [lindex $s 0]
1240 set icon_name [lindex $s 1]
1241
1242 set s [string index $m 0]
1243 if {$s ne {U} && $s ne {_}} {
1244 display_all_files_helper $ui_index $path \
1245 $icon_name $s
1246 }
1247
1248 if {[string index $m 0] eq {U}} {
1249 set s U
1250 } else {
1251 set s [string index $m 1]
1252 }
1253 if {$s ne {_}} {
1254 display_all_files_helper $ui_workdir $path \
1255 $icon_name $s
1256 }
1257 }
1258
1259 $ui_index conf -state disabled
1260 $ui_workdir conf -state disabled
1261 }
1262
1263 ######################################################################
1264 ##
1265 ## icons
1266
1267 set filemask {
1268 #define mask_width 14
1269 #define mask_height 15
1270 static unsigned char mask_bits[] = {
1271 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1272 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1273 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1274 }
1275
1276 image create bitmap file_plain -background white -foreground black -data {
1277 #define plain_width 14
1278 #define plain_height 15
1279 static unsigned char plain_bits[] = {
1280 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1281 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1282 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1283 } -maskdata $filemask
1284
1285 image create bitmap file_mod -background white -foreground blue -data {
1286 #define mod_width 14
1287 #define mod_height 15
1288 static unsigned char mod_bits[] = {
1289 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1290 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1291 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1292 } -maskdata $filemask
1293
1294 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1295 #define file_fulltick_width 14
1296 #define file_fulltick_height 15
1297 static unsigned char file_fulltick_bits[] = {
1298 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1299 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1300 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1301 } -maskdata $filemask
1302
1303 image create bitmap file_parttick -background white -foreground "#005050" -data {
1304 #define parttick_width 14
1305 #define parttick_height 15
1306 static unsigned char parttick_bits[] = {
1307 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1308 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1309 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1310 } -maskdata $filemask
1311
1312 image create bitmap file_question -background white -foreground black -data {
1313 #define file_question_width 14
1314 #define file_question_height 15
1315 static unsigned char file_question_bits[] = {
1316 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1317 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1318 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1319 } -maskdata $filemask
1320
1321 image create bitmap file_removed -background white -foreground red -data {
1322 #define file_removed_width 14
1323 #define file_removed_height 15
1324 static unsigned char file_removed_bits[] = {
1325 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1326 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1327 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1328 } -maskdata $filemask
1329
1330 image create bitmap file_merge -background white -foreground blue -data {
1331 #define file_merge_width 14
1332 #define file_merge_height 15
1333 static unsigned char file_merge_bits[] = {
1334 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1335 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1336 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1337 } -maskdata $filemask
1338
1339 set ui_index .vpane.files.index.list
1340 set ui_workdir .vpane.files.workdir.list
1341
1342 set all_icons(_$ui_index) file_plain
1343 set all_icons(A$ui_index) file_fulltick
1344 set all_icons(M$ui_index) file_fulltick
1345 set all_icons(D$ui_index) file_removed
1346 set all_icons(U$ui_index) file_merge
1347
1348 set all_icons(_$ui_workdir) file_plain
1349 set all_icons(M$ui_workdir) file_mod
1350 set all_icons(D$ui_workdir) file_question
1351 set all_icons(U$ui_workdir) file_merge
1352 set all_icons(O$ui_workdir) file_plain
1353
1354 set max_status_desc 0
1355 foreach i {
1356 {__ {mc "Unmodified"}}
1357
1358 {_M {mc "Modified, not staged"}}
1359 {M_ {mc "Staged for commit"}}
1360 {MM {mc "Portions staged for commit"}}
1361 {MD {mc "Staged for commit, missing"}}
1362
1363 {_O {mc "Untracked, not staged"}}
1364 {A_ {mc "Staged for commit"}}
1365 {AM {mc "Portions staged for commit"}}
1366 {AD {mc "Staged for commit, missing"}}
1367
1368 {_D {mc "Missing"}}
1369 {D_ {mc "Staged for removal"}}
1370 {DO {mc "Staged for removal, still present"}}
1371
1372 {U_ {mc "Requires merge resolution"}}
1373 {UU {mc "Requires merge resolution"}}
1374 {UM {mc "Requires merge resolution"}}
1375 {UD {mc "Requires merge resolution"}}
1376 } {
1377 set text [eval [lindex $i 1]]
1378 if {$max_status_desc < [string length $text]} {
1379 set max_status_desc [string length $text]
1380 }
1381 set all_descs([lindex $i 0]) $text
1382 }
1383 unset i
1384
1385 ######################################################################
1386 ##
1387 ## util
1388
1389 proc bind_button3 {w cmd} {
1390 bind $w <Any-Button-3> $cmd
1391 if {[is_MacOSX]} {
1392 # Mac OS X sends Button-2 on right click through three-button mouse,
1393 # or through trackpad right-clicking (two-finger touch + click).
1394 bind $w <Any-Button-2> $cmd
1395 bind $w <Control-Button-1> $cmd
1396 }
1397 }
1398
1399 proc scrollbar2many {list mode args} {
1400 foreach w $list {eval $w $mode $args}
1401 }
1402
1403 proc many2scrollbar {list mode sb top bottom} {
1404 $sb set $top $bottom
1405 foreach w $list {$w $mode moveto $top}
1406 }
1407
1408 proc incr_font_size {font {amt 1}} {
1409 set sz [font configure $font -size]
1410 incr sz $amt
1411 font configure $font -size $sz
1412 font configure ${font}bold -size $sz
1413 font configure ${font}italic -size $sz
1414 }
1415
1416 ######################################################################
1417 ##
1418 ## ui commands
1419
1420 set starting_gitk_msg [mc "Starting gitk... please wait..."]
1421
1422 proc do_gitk {revs} {
1423 # -- Always start gitk through whatever we were loaded with. This
1424 # lets us bypass using shell process on Windows systems.
1425 #
1426 set exe [file join [file dirname $::_git] gitk]
1427 set cmd [list [info nameofexecutable] $exe]
1428 if {! [file exists $exe]} {
1429 error_popup [mc "Unable to start gitk:\n\n%s does not exist" $exe]
1430 } else {
1431 eval exec $cmd $revs &
1432 ui_status $::starting_gitk_msg
1433 after 10000 {
1434 ui_ready $starting_gitk_msg
1435 }
1436 }
1437 }
1438
1439 set is_quitting 0
1440
1441 proc do_quit {} {
1442 global ui_comm is_quitting repo_config commit_type
1443 global GITGUI_BCK_exists GITGUI_BCK_i
1444
1445 if {$is_quitting} return
1446 set is_quitting 1
1447
1448 if {[winfo exists $ui_comm]} {
1449 # -- Stash our current commit buffer.
1450 #
1451 set save [gitdir GITGUI_MSG]
1452 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1453 file rename -force [gitdir GITGUI_BCK] $save
1454 set GITGUI_BCK_exists 0
1455 } else {
1456 set msg [string trim [$ui_comm get 0.0 end]]
1457 regsub -all -line {[ \r\t]+$} $msg {} msg
1458 if {(![string match amend* $commit_type]
1459 || [$ui_comm edit modified])
1460 && $msg ne {}} {
1461 catch {
1462 set fd [open $save w]
1463 puts -nonewline $fd $msg
1464 close $fd
1465 }
1466 } else {
1467 catch {file delete $save}
1468 }
1469 }
1470
1471 # -- Remove our editor backup, its not needed.
1472 #
1473 after cancel $GITGUI_BCK_i
1474 if {$GITGUI_BCK_exists} {
1475 catch {file delete [gitdir GITGUI_BCK]}
1476 }
1477
1478 # -- Stash our current window geometry into this repository.
1479 #
1480 set cfg_geometry [list]
1481 lappend cfg_geometry [wm geometry .]
1482 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1483 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1484 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1485 set rc_geometry {}
1486 }
1487 if {$cfg_geometry ne $rc_geometry} {
1488 catch {git config gui.geometry $cfg_geometry}
1489 }
1490 }
1491
1492 destroy .
1493 }
1494
1495 proc do_rescan {} {
1496 rescan ui_ready
1497 }
1498
1499 proc do_commit {} {
1500 commit_tree
1501 }
1502
1503 proc toggle_or_diff {w x y} {
1504 global file_states file_lists current_diff_path ui_index ui_workdir
1505 global last_clicked selected_paths
1506
1507 set pos [split [$w index @$x,$y] .]
1508 set lno [lindex $pos 0]
1509 set col [lindex $pos 1]
1510 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1511 if {$path eq {}} {
1512 set last_clicked {}
1513 return
1514 }
1515
1516 set last_clicked [list $w $lno]
1517 array unset selected_paths
1518 $ui_index tag remove in_sel 0.0 end
1519 $ui_workdir tag remove in_sel 0.0 end
1520
1521 if {$col == 0} {
1522 if {$current_diff_path eq $path} {
1523 set after {reshow_diff;}
1524 } else {
1525 set after {}
1526 }
1527 if {$w eq $ui_index} {
1528 update_indexinfo \
1529 "Unstaging [short_path $path] from commit" \
1530 [list $path] \
1531 [concat $after [list ui_ready]]
1532 } elseif {$w eq $ui_workdir} {
1533 update_index \
1534 "Adding [short_path $path]" \
1535 [list $path] \
1536 [concat $after [list ui_ready]]
1537 }
1538 } else {
1539 show_diff $path $w $lno
1540 }
1541 }
1542
1543 proc add_one_to_selection {w x y} {
1544 global file_lists last_clicked selected_paths
1545
1546 set lno [lindex [split [$w index @$x,$y] .] 0]
1547 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1548 if {$path eq {}} {
1549 set last_clicked {}
1550 return
1551 }
1552
1553 if {$last_clicked ne {}
1554 && [lindex $last_clicked 0] ne $w} {
1555 array unset selected_paths
1556 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1557 }
1558
1559 set last_clicked [list $w $lno]
1560 if {[catch {set in_sel $selected_paths($path)}]} {
1561 set in_sel 0
1562 }
1563 if {$in_sel} {
1564 unset selected_paths($path)
1565 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1566 } else {
1567 set selected_paths($path) 1
1568 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1569 }
1570 }
1571
1572 proc add_range_to_selection {w x y} {
1573 global file_lists last_clicked selected_paths
1574
1575 if {[lindex $last_clicked 0] ne $w} {
1576 toggle_or_diff $w $x $y
1577 return
1578 }
1579
1580 set lno [lindex [split [$w index @$x,$y] .] 0]
1581 set lc [lindex $last_clicked 1]
1582 if {$lc < $lno} {
1583 set begin $lc
1584 set end $lno
1585 } else {
1586 set begin $lno
1587 set end $lc
1588 }
1589
1590 foreach path [lrange $file_lists($w) \
1591 [expr {$begin - 1}] \
1592 [expr {$end - 1}]] {
1593 set selected_paths($path) 1
1594 }
1595 $w tag add in_sel $begin.0 [expr {$end + 1}].0
1596 }
1597
1598 ######################################################################
1599 ##
1600 ## config defaults
1601
1602 set cursor_ptr arrow
1603 font create font_diff -family Courier -size 10
1604 font create font_ui
1605 catch {
1606 label .dummy
1607 eval font configure font_ui [font actual [.dummy cget -font]]
1608 destroy .dummy
1609 }
1610
1611 font create font_uiitalic
1612 font create font_uibold
1613 font create font_diffbold
1614 font create font_diffitalic
1615
1616 foreach class {Button Checkbutton Entry Label
1617 Labelframe Listbox Menu Message
1618 Radiobutton Spinbox Text} {
1619 option add *$class.font font_ui
1620 }
1621 unset class
1622
1623 if {[is_Windows] || [is_MacOSX]} {
1624 option add *Menu.tearOff 0
1625 }
1626
1627 if {[is_MacOSX]} {
1628 set M1B M1
1629 set M1T Cmd
1630 } else {
1631 set M1B Control
1632 set M1T Ctrl
1633 }
1634
1635 proc apply_config {} {
1636 global repo_config font_descs
1637
1638 foreach option $font_descs {
1639 set name [lindex $option 0]
1640 set font [lindex $option 1]
1641 if {[catch {
1642 foreach {cn cv} $repo_config(gui.$name) {
1643 font configure $font $cn $cv
1644 }
1645 } err]} {
1646 error_popup [append [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
1647 }
1648 foreach {cn cv} [font configure $font] {
1649 font configure ${font}bold $cn $cv
1650 font configure ${font}italic $cn $cv
1651 }
1652 font configure ${font}bold -weight bold
1653 font configure ${font}italic -slant italic
1654 }
1655 }
1656
1657 set default_config(merge.diffstat) true
1658 set default_config(merge.summary) false
1659 set default_config(merge.verbosity) 2
1660 set default_config(user.name) {}
1661 set default_config(user.email) {}
1662
1663 set default_config(gui.matchtrackingbranch) false
1664 set default_config(gui.pruneduringfetch) false
1665 set default_config(gui.trustmtime) false
1666 set default_config(gui.diffcontext) 5
1667 set default_config(gui.newbranchtemplate) {}
1668 set default_config(gui.fontui) [font configure font_ui]
1669 set default_config(gui.fontdiff) [font configure font_diff]
1670 set font_descs {
1671 {fontui font_ui {mc "Main Font"}}
1672 {fontdiff font_diff {mc "Diff/Console Font"}}
1673 }
1674 load_config 0
1675 apply_config
1676
1677 ######################################################################
1678 ##
1679 ## ui construction
1680
1681 set ui_comm {}
1682
1683 # -- Menu Bar
1684 #
1685 menu .mbar -tearoff 0
1686 .mbar add cascade -label [mc Repository] -menu .mbar.repository
1687 .mbar add cascade -label [mc Edit] -menu .mbar.edit
1688 if {[is_enabled branch]} {
1689 .mbar add cascade -label [mc Branch] -menu .mbar.branch
1690 }
1691 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1692 .mbar add cascade -label [mc Commit] -menu .mbar.commit
1693 }
1694 if {[is_enabled transport]} {
1695 .mbar add cascade -label [mc Merge] -menu .mbar.merge
1696 .mbar add cascade -label [mc Fetch] -menu .mbar.fetch
1697 .mbar add cascade -label [mc Push] -menu .mbar.push
1698 }
1699 . configure -menu .mbar
1700
1701 # -- Repository Menu
1702 #
1703 menu .mbar.repository
1704
1705 .mbar.repository add command \
1706 -label [mc "Browse Current Branch's Files"] \
1707 -command {browser::new $current_branch}
1708 set ui_browse_current [.mbar.repository index last]
1709 .mbar.repository add command \
1710 -label [mc "Browse Branch Files..."] \
1711 -command browser_open::dialog
1712 .mbar.repository add separator
1713
1714 .mbar.repository add command \
1715 -label [mc "Visualize Current Branch's History"] \
1716 -command {do_gitk $current_branch}
1717 set ui_visualize_current [.mbar.repository index last]
1718 .mbar.repository add command \
1719 -label [mc "Visualize All Branch History"] \
1720 -command {do_gitk --all}
1721 .mbar.repository add separator
1722
1723 proc current_branch_write {args} {
1724 global current_branch
1725 .mbar.repository entryconf $::ui_browse_current \
1726 -label [mc "Browse %s's Files" $current_branch]
1727 .mbar.repository entryconf $::ui_visualize_current \
1728 -label [mc "Visualize %s's History" $current_branch]
1729 }
1730 trace add variable current_branch write current_branch_write
1731
1732 if {[is_enabled multicommit]} {
1733 .mbar.repository add command -label [mc "Database Statistics"] \
1734 -command do_stats
1735
1736 .mbar.repository add command -label [mc "Compress Database"] \
1737 -command do_gc
1738
1739 .mbar.repository add command -label [mc "Verify Database"] \
1740 -command do_fsck_objects
1741
1742 .mbar.repository add separator
1743
1744 if {[is_Cygwin]} {
1745 .mbar.repository add command \
1746 -label [mc "Create Desktop Icon"] \
1747 -command do_cygwin_shortcut
1748 } elseif {[is_Windows]} {
1749 .mbar.repository add command \
1750 -label [mc "Create Desktop Icon"] \
1751 -command do_windows_shortcut
1752 } elseif {[is_MacOSX]} {
1753 .mbar.repository add command \
1754 -label [mc "Create Desktop Icon"] \
1755 -command do_macosx_app
1756 }
1757 }
1758
1759 .mbar.repository add command -label [mc Quit] \
1760 -command do_quit \
1761 -accelerator $M1T-Q
1762
1763 # -- Edit Menu
1764 #
1765 menu .mbar.edit
1766 .mbar.edit add command -label [mc Undo] \
1767 -command {catch {[focus] edit undo}} \
1768 -accelerator $M1T-Z
1769 .mbar.edit add command -label [mc Redo] \
1770 -command {catch {[focus] edit redo}} \
1771 -accelerator $M1T-Y
1772 .mbar.edit add separator
1773 .mbar.edit add command -label [mc Cut] \
1774 -command {catch {tk_textCut [focus]}} \
1775 -accelerator $M1T-X
1776 .mbar.edit add command -label [mc Copy] \
1777 -command {catch {tk_textCopy [focus]}} \
1778 -accelerator $M1T-C
1779 .mbar.edit add command -label [mc Paste] \
1780 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1781 -accelerator $M1T-V
1782 .mbar.edit add command -label [mc Delete] \
1783 -command {catch {[focus] delete sel.first sel.last}} \
1784 -accelerator Del
1785 .mbar.edit add separator
1786 .mbar.edit add command -label [mc "Select All"] \
1787 -command {catch {[focus] tag add sel 0.0 end}} \
1788 -accelerator $M1T-A
1789
1790 # -- Branch Menu
1791 #
1792 if {[is_enabled branch]} {
1793 menu .mbar.branch
1794
1795 .mbar.branch add command -label [mc "Create..."] \
1796 -command branch_create::dialog \
1797 -accelerator $M1T-N
1798 lappend disable_on_lock [list .mbar.branch entryconf \
1799 [.mbar.branch index last] -state]
1800
1801 .mbar.branch add command -label [mc "Checkout..."] \
1802 -command branch_checkout::dialog \
1803 -accelerator $M1T-O
1804 lappend disable_on_lock [list .mbar.branch entryconf \
1805 [.mbar.branch index last] -state]
1806
1807 .mbar.branch add command -label [mc "Rename..."] \
1808 -command branch_rename::dialog
1809 lappend disable_on_lock [list .mbar.branch entryconf \
1810 [.mbar.branch index last] -state]
1811
1812 .mbar.branch add command -label [mc "Delete..."] \
1813 -command branch_delete::dialog
1814 lappend disable_on_lock [list .mbar.branch entryconf \
1815 [.mbar.branch index last] -state]
1816
1817 .mbar.branch add command -label [mc "Reset..."] \
1818 -command merge::reset_hard
1819 lappend disable_on_lock [list .mbar.branch entryconf \
1820 [.mbar.branch index last] -state]
1821 }
1822
1823 # -- Commit Menu
1824 #
1825 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1826 menu .mbar.commit
1827
1828 .mbar.commit add radiobutton \
1829 -label [mc "New Commit"] \
1830 -command do_select_commit_type \
1831 -variable selected_commit_type \
1832 -value new
1833 lappend disable_on_lock \
1834 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1835
1836 .mbar.commit add radiobutton \
1837 -label [mc "Amend Last Commit"] \
1838 -command do_select_commit_type \
1839 -variable selected_commit_type \
1840 -value amend
1841 lappend disable_on_lock \
1842 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1843
1844 .mbar.commit add separator
1845
1846 .mbar.commit add command -label [mc Rescan] \
1847 -command do_rescan \
1848 -accelerator F5
1849 lappend disable_on_lock \
1850 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1851
1852 .mbar.commit add command -label [mc "Stage To Commit"] \
1853 -command do_add_selection
1854 lappend disable_on_lock \
1855 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1856
1857 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
1858 -command do_add_all \
1859 -accelerator $M1T-I
1860 lappend disable_on_lock \
1861 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1862
1863 .mbar.commit add command -label [mc "Unstage From Commit"] \
1864 -command do_unstage_selection
1865 lappend disable_on_lock \
1866 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1867
1868 .mbar.commit add command -label [mc "Revert Changes"] \
1869 -command do_revert_selection
1870 lappend disable_on_lock \
1871 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1872
1873 .mbar.commit add separator
1874
1875 .mbar.commit add command -label [mc "Sign Off"] \
1876 -command do_signoff \
1877 -accelerator $M1T-S
1878
1879 .mbar.commit add command -label [mc Commit] \
1880 -command do_commit \
1881 -accelerator $M1T-Return
1882 lappend disable_on_lock \
1883 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1884 }
1885
1886 # -- Merge Menu
1887 #
1888 if {[is_enabled branch]} {
1889 menu .mbar.merge
1890 .mbar.merge add command -label [mc "Local Merge..."] \
1891 -command merge::dialog \
1892 -accelerator $M1T-M
1893 lappend disable_on_lock \
1894 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1895 .mbar.merge add command -label [mc "Abort Merge..."] \
1896 -command merge::reset_hard
1897 lappend disable_on_lock \
1898 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1899 }
1900
1901 # -- Transport Menu
1902 #
1903 if {[is_enabled transport]} {
1904 menu .mbar.fetch
1905
1906 menu .mbar.push
1907 .mbar.push add command -label [mc "Push..."] \
1908 -command do_push_anywhere \
1909 -accelerator $M1T-P
1910 .mbar.push add command -label [mc "Delete..."] \
1911 -command remote_branch_delete::dialog
1912 }
1913
1914 if {[is_MacOSX]} {
1915 # -- Apple Menu (Mac OS X only)
1916 #
1917 .mbar add cascade -label [mc Apple] -menu .mbar.apple
1918 menu .mbar.apple
1919
1920 .mbar.apple add command -label [mc "About %s" [appname]] \
1921 -command do_about
1922 .mbar.apple add command -label [mc "Options..."] \
1923 -command do_options
1924 } else {
1925 # -- Edit Menu
1926 #
1927 .mbar.edit add separator
1928 .mbar.edit add command -label [mc "Options..."] \
1929 -command do_options
1930 }
1931
1932 # -- Help Menu
1933 #
1934 .mbar add cascade -label [mc Help] -menu .mbar.help
1935 menu .mbar.help
1936
1937 if {![is_MacOSX]} {
1938 .mbar.help add command -label [mc "About %s" [appname]] \
1939 -command do_about
1940 }
1941
1942 set browser {}
1943 catch {set browser $repo_config(instaweb.browser)}
1944 set doc_path [file dirname [gitexec]]
1945 set doc_path [file join $doc_path Documentation index.html]
1946
1947 if {[is_Cygwin]} {
1948 set doc_path [exec cygpath --mixed $doc_path]
1949 }
1950
1951 if {$browser eq {}} {
1952 if {[is_MacOSX]} {
1953 set browser open
1954 } elseif {[is_Cygwin]} {
1955 set program_files [file dirname [exec cygpath --windir]]
1956 set program_files [file join $program_files {Program Files}]
1957 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1958 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1959 if {[file exists $firefox]} {
1960 set browser $firefox
1961 } elseif {[file exists $ie]} {
1962 set browser $ie
1963 }
1964 unset program_files firefox ie
1965 }
1966 }
1967
1968 if {[file isfile $doc_path]} {
1969 set doc_url "file:$doc_path"
1970 } else {
1971 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1972 }
1973
1974 if {$browser ne {}} {
1975 .mbar.help add command -label [mc "Online Documentation"] \
1976 -command [list exec $browser $doc_url &]
1977 }
1978 unset browser doc_path doc_url
1979
1980 set root_exists 0
1981 bind . <Visibility> {
1982 bind . <Visibility> {}
1983 set root_exists 1
1984 }
1985
1986 # -- Standard bindings
1987 #
1988 wm protocol . WM_DELETE_WINDOW do_quit
1989 bind all <$M1B-Key-q> do_quit
1990 bind all <$M1B-Key-Q> do_quit
1991 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1992 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1993
1994 set subcommand_args {}
1995 proc usage {} {
1996 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1997 exit 1
1998 }
1999
2000 # -- Not a normal commit type invocation? Do that instead!
2001 #
2002 switch -- $subcommand {
2003 browser -
2004 blame {
2005 set subcommand_args {rev? path}
2006 if {$argv eq {}} usage
2007 set head {}
2008 set path {}
2009 set is_path 0
2010 foreach a $argv {
2011 if {$is_path || [file exists $_prefix$a]} {
2012 if {$path ne {}} usage
2013 set path $_prefix$a
2014 break
2015 } elseif {$a eq {--}} {
2016 if {$path ne {}} {
2017 if {$head ne {}} usage
2018 set head $path
2019 set path {}
2020 }
2021 set is_path 1
2022 } elseif {$head eq {}} {
2023 if {$head ne {}} usage
2024 set head $a
2025 set is_path 1
2026 } else {
2027 usage
2028 }
2029 }
2030 unset is_path
2031
2032 if {$head ne {} && $path eq {}} {
2033 set path $_prefix$head
2034 set head {}
2035 }
2036
2037 if {$head eq {}} {
2038 load_current_branch
2039 } else {
2040 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2041 if {[catch {
2042 set head [git rev-parse --verify $head]
2043 } err]} {
2044 puts stderr $err
2045 exit 1
2046 }
2047 }
2048 set current_branch $head
2049 }
2050
2051 switch -- $subcommand {
2052 browser {
2053 if {$head eq {}} {
2054 if {$path ne {} && [file isdirectory $path]} {
2055 set head $current_branch
2056 } else {
2057 set head $path
2058 set path {}
2059 }
2060 }
2061 browser::new $head $path
2062 }
2063 blame {
2064 if {$head eq {} && ![file exists $path]} {
2065 puts stderr "fatal: cannot stat path $path: No such file or directory"
2066 exit 1
2067 }
2068 blame::new $head $path
2069 }
2070 }
2071 return
2072 }
2073 citool -
2074 gui {
2075 if {[llength $argv] != 0} {
2076 puts -nonewline stderr "usage: $argv0"
2077 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2078 puts -nonewline stderr " $subcommand"
2079 }
2080 puts stderr {}
2081 exit 1
2082 }
2083 # fall through to setup UI for commits
2084 }
2085 default {
2086 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2087 exit 1
2088 }
2089 }
2090
2091 # -- Branch Control
2092 #
2093 frame .branch \
2094 -borderwidth 1 \
2095 -relief sunken
2096 label .branch.l1 \
2097 -text [mc "Current Branch:"] \
2098 -anchor w \
2099 -justify left
2100 label .branch.cb \
2101 -textvariable current_branch \
2102 -anchor w \
2103 -justify left
2104 pack .branch.l1 -side left
2105 pack .branch.cb -side left -fill x
2106 pack .branch -side top -fill x
2107
2108 # -- Main Window Layout
2109 #
2110 panedwindow .vpane -orient vertical
2111 panedwindow .vpane.files -orient horizontal
2112 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2113 pack .vpane -anchor n -side top -fill both -expand 1
2114
2115 # -- Index File List
2116 #
2117 frame .vpane.files.index -height 100 -width 200
2118 label .vpane.files.index.title -text [mc "Staged Changes (Will Be Committed)"] \
2119 -background lightgreen
2120 text $ui_index -background white -borderwidth 0 \
2121 -width 20 -height 10 \
2122 -wrap none \
2123 -cursor $cursor_ptr \
2124 -xscrollcommand {.vpane.files.index.sx set} \
2125 -yscrollcommand {.vpane.files.index.sy set} \
2126 -state disabled
2127 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2128 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2129 pack .vpane.files.index.title -side top -fill x
2130 pack .vpane.files.index.sx -side bottom -fill x
2131 pack .vpane.files.index.sy -side right -fill y
2132 pack $ui_index -side left -fill both -expand 1
2133 .vpane.files add .vpane.files.index -sticky nsew
2134
2135 # -- Working Directory File List
2136 #
2137 frame .vpane.files.workdir -height 100 -width 200
2138 label .vpane.files.workdir.title -text [mc "Unstaged Changes (Will Not Be Committed)"] \
2139 -background lightsalmon
2140 text $ui_workdir -background white -borderwidth 0 \
2141 -width 20 -height 10 \
2142 -wrap none \
2143 -cursor $cursor_ptr \
2144 -xscrollcommand {.vpane.files.workdir.sx set} \
2145 -yscrollcommand {.vpane.files.workdir.sy set} \
2146 -state disabled
2147 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2148 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2149 pack .vpane.files.workdir.title -side top -fill x
2150 pack .vpane.files.workdir.sx -side bottom -fill x
2151 pack .vpane.files.workdir.sy -side right -fill y
2152 pack $ui_workdir -side left -fill both -expand 1
2153 .vpane.files add .vpane.files.workdir -sticky nsew
2154
2155 foreach i [list $ui_index $ui_workdir] {
2156 $i tag conf in_diff -background lightgray
2157 $i tag conf in_sel -background lightgray
2158 }
2159 unset i
2160
2161 # -- Diff and Commit Area
2162 #
2163 frame .vpane.lower -height 300 -width 400
2164 frame .vpane.lower.commarea
2165 frame .vpane.lower.diff -relief sunken -borderwidth 1
2166 pack .vpane.lower.commarea -side top -fill x
2167 pack .vpane.lower.diff -side bottom -fill both -expand 1
2168 .vpane add .vpane.lower -sticky nsew
2169
2170 # -- Commit Area Buttons
2171 #
2172 frame .vpane.lower.commarea.buttons
2173 label .vpane.lower.commarea.buttons.l -text {} \
2174 -anchor w \
2175 -justify left
2176 pack .vpane.lower.commarea.buttons.l -side top -fill x
2177 pack .vpane.lower.commarea.buttons -side left -fill y
2178
2179 button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2180 -command do_rescan
2181 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2182 lappend disable_on_lock \
2183 {.vpane.lower.commarea.buttons.rescan conf -state}
2184
2185 button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2186 -command do_add_all
2187 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2188 lappend disable_on_lock \
2189 {.vpane.lower.commarea.buttons.incall conf -state}
2190
2191 button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2192 -command do_signoff
2193 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2194
2195 button .vpane.lower.commarea.buttons.commit -text [mc Commit] \
2196 -command do_commit
2197 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2198 lappend disable_on_lock \
2199 {.vpane.lower.commarea.buttons.commit conf -state}
2200
2201 button .vpane.lower.commarea.buttons.push -text [mc Push] \
2202 -command do_push_anywhere
2203 pack .vpane.lower.commarea.buttons.push -side top -fill x
2204
2205 # -- Commit Message Buffer
2206 #
2207 frame .vpane.lower.commarea.buffer
2208 frame .vpane.lower.commarea.buffer.header
2209 set ui_comm .vpane.lower.commarea.buffer.t
2210 set ui_coml .vpane.lower.commarea.buffer.header.l
2211 radiobutton .vpane.lower.commarea.buffer.header.new \
2212 -text [mc "New Commit"] \
2213 -command do_select_commit_type \
2214 -variable selected_commit_type \
2215 -value new
2216 lappend disable_on_lock \
2217 [list .vpane.lower.commarea.buffer.header.new conf -state]
2218 radiobutton .vpane.lower.commarea.buffer.header.amend \
2219 -text [mc "Amend Last Commit"] \
2220 -command do_select_commit_type \
2221 -variable selected_commit_type \
2222 -value amend
2223 lappend disable_on_lock \
2224 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2225 label $ui_coml \
2226 -anchor w \
2227 -justify left
2228 proc trace_commit_type {varname args} {
2229 global ui_coml commit_type
2230 switch -glob -- $commit_type {
2231 initial {set txt [mc "Initial Commit Message:"]}
2232 amend {set txt [mc "Amended Commit Message:"]}
2233 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2234 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
2235 merge {set txt [mc "Merge Commit Message:"]}
2236 * {set txt [mc "Commit Message:"]}
2237 }
2238 $ui_coml conf -text $txt
2239 }
2240 trace add variable commit_type write trace_commit_type
2241 pack $ui_coml -side left -fill x
2242 pack .vpane.lower.commarea.buffer.header.amend -side right
2243 pack .vpane.lower.commarea.buffer.header.new -side right
2244
2245 text $ui_comm -background white -borderwidth 1 \
2246 -undo true \
2247 -maxundo 20 \
2248 -autoseparators true \
2249 -relief sunken \
2250 -width 75 -height 9 -wrap none \
2251 -font font_diff \
2252 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2253 scrollbar .vpane.lower.commarea.buffer.sby \
2254 -command [list $ui_comm yview]
2255 pack .vpane.lower.commarea.buffer.header -side top -fill x
2256 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2257 pack $ui_comm -side left -fill y
2258 pack .vpane.lower.commarea.buffer -side left -fill y
2259
2260 # -- Commit Message Buffer Context Menu
2261 #
2262 set ctxm .vpane.lower.commarea.buffer.ctxm
2263 menu $ctxm -tearoff 0
2264 $ctxm add command \
2265 -label [mc Cut] \
2266 -command {tk_textCut $ui_comm}
2267 $ctxm add command \
2268 -label [mc Copy] \
2269 -command {tk_textCopy $ui_comm}
2270 $ctxm add command \
2271 -label [mc Paste] \
2272 -command {tk_textPaste $ui_comm}
2273 $ctxm add command \
2274 -label [mc Delete] \
2275 -command {$ui_comm delete sel.first sel.last}
2276 $ctxm add separator
2277 $ctxm add command \
2278 -label [mc "Select All"] \
2279 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2280 $ctxm add command \
2281 -label [mc "Copy All"] \
2282 -command {
2283 $ui_comm tag add sel 0.0 end
2284 tk_textCopy $ui_comm
2285 $ui_comm tag remove sel 0.0 end
2286 }
2287 $ctxm add separator
2288 $ctxm add command \
2289 -label [mc "Sign Off"] \
2290 -command do_signoff
2291 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2292
2293 # -- Diff Header
2294 #
2295 proc trace_current_diff_path {varname args} {
2296 global current_diff_path diff_actions file_states
2297 if {$current_diff_path eq {}} {
2298 set s {}
2299 set f {}
2300 set p {}
2301 set o disabled
2302 } else {
2303 set p $current_diff_path
2304 set s [mapdesc [lindex $file_states($p) 0] $p]
2305 set f [mc "File:"]
2306 set p [escape_path $p]
2307 set o normal
2308 }
2309
2310 .vpane.lower.diff.header.status configure -text $s
2311 .vpane.lower.diff.header.file configure -text $f
2312 .vpane.lower.diff.header.path configure -text $p
2313 foreach w $diff_actions {
2314 uplevel #0 $w $o
2315 }
2316 }
2317 trace add variable current_diff_path write trace_current_diff_path
2318
2319 frame .vpane.lower.diff.header -background gold
2320 label .vpane.lower.diff.header.status \
2321 -background gold \
2322 -width $max_status_desc \
2323 -anchor w \
2324 -justify left
2325 label .vpane.lower.diff.header.file \
2326 -background gold \
2327 -anchor w \
2328 -justify left
2329 label .vpane.lower.diff.header.path \
2330 -background gold \
2331 -anchor w \
2332 -justify left
2333 pack .vpane.lower.diff.header.status -side left
2334 pack .vpane.lower.diff.header.file -side left
2335 pack .vpane.lower.diff.header.path -fill x
2336 set ctxm .vpane.lower.diff.header.ctxm
2337 menu $ctxm -tearoff 0
2338 $ctxm add command \
2339 -label [mc Copy] \
2340 -command {
2341 clipboard clear
2342 clipboard append \
2343 -format STRING \
2344 -type STRING \
2345 -- $current_diff_path
2346 }
2347 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2348 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2349
2350 # -- Diff Body
2351 #
2352 frame .vpane.lower.diff.body
2353 set ui_diff .vpane.lower.diff.body.t
2354 text $ui_diff -background white -borderwidth 0 \
2355 -width 80 -height 15 -wrap none \
2356 -font font_diff \
2357 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2358 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2359 -state disabled
2360 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2361 -command [list $ui_diff xview]
2362 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2363 -command [list $ui_diff yview]
2364 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2365 pack .vpane.lower.diff.body.sby -side right -fill y
2366 pack $ui_diff -side left -fill both -expand 1
2367 pack .vpane.lower.diff.header -side top -fill x
2368 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2369
2370 $ui_diff tag conf d_cr -elide true
2371 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2372 $ui_diff tag conf d_+ -foreground {#00a000}
2373 $ui_diff tag conf d_- -foreground red
2374
2375 $ui_diff tag conf d_++ -foreground {#00a000}
2376 $ui_diff tag conf d_-- -foreground red
2377 $ui_diff tag conf d_+s \
2378 -foreground {#00a000} \
2379 -background {#e2effa}
2380 $ui_diff tag conf d_-s \
2381 -foreground red \
2382 -background {#e2effa}
2383 $ui_diff tag conf d_s+ \
2384 -foreground {#00a000} \
2385 -background ivory1
2386 $ui_diff tag conf d_s- \
2387 -foreground red \
2388 -background ivory1
2389
2390 $ui_diff tag conf d<<<<<<< \
2391 -foreground orange \
2392 -font font_diffbold
2393 $ui_diff tag conf d======= \
2394 -foreground orange \
2395 -font font_diffbold
2396 $ui_diff tag conf d>>>>>>> \
2397 -foreground orange \
2398 -font font_diffbold
2399
2400 $ui_diff tag raise sel
2401
2402 # -- Diff Body Context Menu
2403 #
2404 set ctxm .vpane.lower.diff.body.ctxm
2405 menu $ctxm -tearoff 0
2406 $ctxm add command \
2407 -label [mc Refresh] \
2408 -command reshow_diff
2409 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2410 $ctxm add command \
2411 -label [mc Copy] \
2412 -command {tk_textCopy $ui_diff}
2413 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2414 $ctxm add command \
2415 -label [mc "Select All"] \
2416 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2417 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2418 $ctxm add command \
2419 -label [mc "Copy All"] \
2420 -command {
2421 $ui_diff tag add sel 0.0 end
2422 tk_textCopy $ui_diff
2423 $ui_diff tag remove sel 0.0 end
2424 }
2425 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2426 $ctxm add separator
2427 $ctxm add command \
2428 -label [mc "Apply/Reverse Hunk"] \
2429 -command {apply_hunk $cursorX $cursorY}
2430 set ui_diff_applyhunk [$ctxm index last]
2431 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2432 $ctxm add separator
2433 $ctxm add command \
2434 -label [mc "Decrease Font Size"] \
2435 -command {incr_font_size font_diff -1}
2436 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2437 $ctxm add command \
2438 -label [mc "Increase Font Size"] \
2439 -command {incr_font_size font_diff 1}
2440 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2441 $ctxm add separator
2442 $ctxm add command \
2443 -label [mc "Show Less Context"] \
2444 -command {if {$repo_config(gui.diffcontext) >= 1} {
2445 incr repo_config(gui.diffcontext) -1
2446 reshow_diff
2447 }}
2448 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2449 $ctxm add command \
2450 -label [mc "Show More Context"] \
2451 -command {if {$repo_config(gui.diffcontext) < 99} {
2452 incr repo_config(gui.diffcontext)
2453 reshow_diff
2454 }}
2455 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2456 $ctxm add separator
2457 $ctxm add command -label [mc "Options..."] \
2458 -command do_options
2459 proc popup_diff_menu {ctxm x y X Y} {
2460 global current_diff_path file_states
2461 set ::cursorX $x
2462 set ::cursorY $y
2463 if {$::ui_index eq $::current_diff_side} {
2464 set l [mc "Unstage Hunk From Commit"]
2465 } else {
2466 set l [mc "Stage Hunk For Commit"]
2467 }
2468 if {$::is_3way_diff
2469 || $current_diff_path eq {}
2470 || ![info exists file_states($current_diff_path)]
2471 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2472 set s disabled
2473 } else {
2474 set s normal
2475 }
2476 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2477 tk_popup $ctxm $X $Y
2478 }
2479 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2480
2481 # -- Status Bar
2482 #
2483 set main_status [::status_bar::new .status]
2484 pack .status -anchor w -side bottom -fill x
2485 $main_status show [mc "Initializing..."]
2486
2487 # -- Load geometry
2488 #
2489 catch {
2490 set gm $repo_config(gui.geometry)
2491 wm geometry . [lindex $gm 0]
2492 .vpane sash place 0 \
2493 [lindex [.vpane sash coord 0] 0] \
2494 [lindex $gm 1]
2495 .vpane.files sash place 0 \
2496 [lindex $gm 2] \
2497 [lindex [.vpane.files sash coord 0] 1]
2498 unset gm
2499 }
2500
2501 # -- Key Bindings
2502 #
2503 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2504 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2505 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2506 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2507 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2508 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2509 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2510 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2511 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2512 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2513 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2514
2515 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2516 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2517 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2518 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2519 bind $ui_diff <$M1B-Key-v> {break}
2520 bind $ui_diff <$M1B-Key-V> {break}
2521 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2522 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2523 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2524 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2525 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2526 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2527 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
2528 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
2529 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
2530 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
2531 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2532 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
2533 bind $ui_diff <Button-1> {focus %W}
2534
2535 if {[is_enabled branch]} {
2536 bind . <$M1B-Key-n> branch_create::dialog
2537 bind . <$M1B-Key-N> branch_create::dialog
2538 bind . <$M1B-Key-o> branch_checkout::dialog
2539 bind . <$M1B-Key-O> branch_checkout::dialog
2540 bind . <$M1B-Key-m> merge::dialog
2541 bind . <$M1B-Key-M> merge::dialog
2542 }
2543 if {[is_enabled transport]} {
2544 bind . <$M1B-Key-p> do_push_anywhere
2545 bind . <$M1B-Key-P> do_push_anywhere
2546 }
2547
2548 bind . <Key-F5> do_rescan
2549 bind . <$M1B-Key-r> do_rescan
2550 bind . <$M1B-Key-R> do_rescan
2551 bind . <$M1B-Key-s> do_signoff
2552 bind . <$M1B-Key-S> do_signoff
2553 bind . <$M1B-Key-i> do_add_all
2554 bind . <$M1B-Key-I> do_add_all
2555 bind . <$M1B-Key-Return> do_commit
2556 foreach i [list $ui_index $ui_workdir] {
2557 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2558 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2559 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2560 }
2561 unset i
2562
2563 set file_lists($ui_index) [list]
2564 set file_lists($ui_workdir) [list]
2565
2566 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2567 focus -force $ui_comm
2568
2569 # -- Warn the user about environmental problems. Cygwin's Tcl
2570 # does *not* pass its env array onto any processes it spawns.
2571 # This means that git processes get none of our environment.
2572 #
2573 if {[is_Cygwin]} {
2574 set ignored_env 0
2575 set suggest_user {}
2576 set msg "Possible environment issues exist.
2577
2578 The following environment variables are probably
2579 going to be ignored by any Git subprocess run
2580 by [appname]:
2581
2582 "
2583 foreach name [array names env] {
2584 switch -regexp -- $name {
2585 {^GIT_INDEX_FILE$} -
2586 {^GIT_OBJECT_DIRECTORY$} -
2587 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2588 {^GIT_DIFF_OPTS$} -
2589 {^GIT_EXTERNAL_DIFF$} -
2590 {^GIT_PAGER$} -
2591 {^GIT_TRACE$} -
2592 {^GIT_CONFIG$} -
2593 {^GIT_CONFIG_LOCAL$} -
2594 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2595 append msg " - $name\n"
2596 incr ignored_env
2597 }
2598 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2599 append msg " - $name\n"
2600 incr ignored_env
2601 set suggest_user $name
2602 }
2603 }
2604 }
2605 if {$ignored_env > 0} {
2606 append msg "
2607 This is due to a known issue with the
2608 Tcl binary distributed by Cygwin."
2609
2610 if {$suggest_user ne {}} {
2611 append msg "
2612
2613 A good replacement for $suggest_user
2614 is placing values for the user.name and
2615 user.email settings into your personal
2616 ~/.gitconfig file.
2617 "
2618 }
2619 warn_popup $msg
2620 }
2621 unset ignored_env msg suggest_user name
2622 }
2623
2624 # -- Only initialize complex UI if we are going to stay running.
2625 #
2626 if {[is_enabled transport]} {
2627 load_all_remotes
2628
2629 populate_fetch_menu
2630 populate_push_menu
2631 }
2632
2633 if {[winfo exists $ui_comm]} {
2634 set GITGUI_BCK_exists [load_message GITGUI_BCK]
2635
2636 # -- If both our backup and message files exist use the
2637 # newer of the two files to initialize the buffer.
2638 #
2639 if {$GITGUI_BCK_exists} {
2640 set m [gitdir GITGUI_MSG]
2641 if {[file isfile $m]} {
2642 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2643 catch {file delete [gitdir GITGUI_MSG]}
2644 } else {
2645 $ui_comm delete 0.0 end
2646 $ui_comm edit reset
2647 $ui_comm edit modified false
2648 catch {file delete [gitdir GITGUI_BCK]}
2649 set GITGUI_BCK_exists 0
2650 }
2651 }
2652 unset m
2653 }
2654
2655 proc backup_commit_buffer {} {
2656 global ui_comm GITGUI_BCK_exists
2657
2658 set m [$ui_comm edit modified]
2659 if {$m || $GITGUI_BCK_exists} {
2660 set msg [string trim [$ui_comm get 0.0 end]]
2661 regsub -all -line {[ \r\t]+$} $msg {} msg
2662
2663 if {$msg eq {}} {
2664 if {$GITGUI_BCK_exists} {
2665 catch {file delete [gitdir GITGUI_BCK]}
2666 set GITGUI_BCK_exists 0
2667 }
2668 } elseif {$m} {
2669 catch {
2670 set fd [open [gitdir GITGUI_BCK] w]
2671 puts -nonewline $fd $msg
2672 close $fd
2673 set GITGUI_BCK_exists 1
2674 }
2675 }
2676
2677 $ui_comm edit modified false
2678 }
2679
2680 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2681 }
2682
2683 backup_commit_buffer
2684 }
2685
2686 lock_index begin-read
2687 if {![winfo ismapped .]} {
2688 wm deiconify .
2689 }
2690 after 1 do_rescan
2691 if {[is_enabled multicommit]} {
2692 after 1000 hint_gc
2693 }