git-gui: Verify Tcl/Tk is new enough for our needs
[git/dkf.git] / git-gui.sh
blobcc1625bfac11e575a6155eaf9f227a91c637de9d
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 set appvers {@@GITGUI_VERSION@@}
6 set copyright {
7 Copyright © 2006, 2007 Shawn Pearce, et. al.
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
23 ######################################################################
25 ## Tcl/Tk sanity check
27 if {[catch {package require Tcl 8.4} err]
28 || [catch {package require Tk 8.4} err]
29 } {
30 catch {wm withdraw .}
31 tk_messageBox \
32 -icon error \
33 -type ok \
34 -title "git-gui: fatal error" \
35 -message $err
36 exit 1
39 ######################################################################
41 ## configure our library
43 set oguilib {@@GITGUI_LIBDIR@@}
44 set oguirel {@@GITGUI_RELATIVE@@}
45 if {$oguirel eq {1}} {
46 set oguilib [file dirname [file dirname [file normalize $argv0]]]
47 set oguilib [file join $oguilib share git-gui lib]
48 } elseif {[string match @@* $oguirel]} {
49 set oguilib [file join [file dirname [file normalize $argv0]] lib]
51 set idx [file join $oguilib tclIndex]
52 catch {
53 set fd [open $idx r]
54 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
55 set idx [list]
56 while {[gets $fd n] >= 0} {
57 if {$n ne {} && ![string match #* $n]} {
58 lappend idx $n
61 } else {
62 set idx {}
64 close $fd
66 if {$idx ne {}} {
67 set loaded [list]
68 foreach p $idx {
69 if {[lsearch -exact $loaded $p] >= 0} continue
70 puts $p
71 source [file join $oguilib $p]
72 lappend loaded $p
74 unset loaded p
75 } else {
76 set auto_path [concat [list $oguilib] $auto_path]
78 unset -nocomplain oguilib oguirel idx fd
80 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
81 unset _verbose
82 rename auto_load real__auto_load
83 proc auto_load {name args} {
84 puts stderr "auto_load $name"
85 return [uplevel 1 real__auto_load $name $args]
87 rename source real__source
88 proc source {name} {
89 puts stderr "source $name"
90 uplevel 1 real__source $name
94 ######################################################################
96 ## read only globals
98 set _appname [lindex [file split $argv0] end]
99 set _gitdir {}
100 set _gitexec {}
101 set _reponame {}
102 set _iscygwin {}
104 proc appname {} {
105 global _appname
106 return $_appname
109 proc gitdir {args} {
110 global _gitdir
111 if {$args eq {}} {
112 return $_gitdir
114 return [eval [concat [list file join $_gitdir] $args]]
117 proc gitexec {args} {
118 global _gitexec
119 if {$_gitexec eq {}} {
120 if {[catch {set _gitexec [git --exec-path]} err]} {
121 error "Git not installed?\n\n$err"
124 if {$args eq {}} {
125 return $_gitexec
127 return [eval [concat [list file join $_gitexec] $args]]
130 proc reponame {} {
131 global _reponame
132 return $_reponame
135 proc is_MacOSX {} {
136 global tcl_platform tk_library
137 if {[tk windowingsystem] eq {aqua}} {
138 return 1
140 return 0
143 proc is_Windows {} {
144 global tcl_platform
145 if {$tcl_platform(platform) eq {windows}} {
146 return 1
148 return 0
151 proc is_Cygwin {} {
152 global tcl_platform _iscygwin
153 if {$_iscygwin eq {}} {
154 if {$tcl_platform(platform) eq {windows}} {
155 if {[catch {set p [exec cygpath --windir]} err]} {
156 set _iscygwin 0
157 } else {
158 set _iscygwin 1
160 } else {
161 set _iscygwin 0
164 return $_iscygwin
167 proc is_enabled {option} {
168 global enabled_options
169 if {[catch {set on $enabled_options($option)}]} {return 0}
170 return $on
173 proc enable_option {option} {
174 global enabled_options
175 set enabled_options($option) 1
178 proc disable_option {option} {
179 global enabled_options
180 set enabled_options($option) 0
183 ######################################################################
185 ## config
187 proc is_many_config {name} {
188 switch -glob -- $name {
189 remote.*.fetch -
190 remote.*.push
191 {return 1}
193 {return 0}
197 proc is_config_true {name} {
198 global repo_config
199 if {[catch {set v $repo_config($name)}]} {
200 return 0
201 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
202 return 1
203 } else {
204 return 0
208 proc load_config {include_global} {
209 global repo_config global_config default_config
211 array unset global_config
212 if {$include_global} {
213 catch {
214 set fd_rc [open "| git config --global --list" r]
215 while {[gets $fd_rc line] >= 0} {
216 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
217 if {[is_many_config $name]} {
218 lappend global_config($name) $value
219 } else {
220 set global_config($name) $value
224 close $fd_rc
228 array unset repo_config
229 catch {
230 set fd_rc [open "| git config --list" r]
231 while {[gets $fd_rc line] >= 0} {
232 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
233 if {[is_many_config $name]} {
234 lappend repo_config($name) $value
235 } else {
236 set repo_config($name) $value
240 close $fd_rc
243 foreach name [array names default_config] {
244 if {[catch {set v $global_config($name)}]} {
245 set global_config($name) $default_config($name)
247 if {[catch {set v $repo_config($name)}]} {
248 set repo_config($name) $default_config($name)
253 ######################################################################
255 ## handy utils
257 proc git {args} {
258 return [eval exec git $args]
261 auto_load tk_optionMenu
262 rename tk_optionMenu real__tkOptionMenu
263 proc tk_optionMenu {w varName args} {
264 set m [eval real__tkOptionMenu $w $varName $args]
265 $m configure -font font_ui
266 $w configure -font font_ui
267 return $m
270 ######################################################################
272 ## version check
274 if {{--version} eq $argv || {version} eq $argv} {
275 puts "git-gui version $appvers"
276 exit
279 set req_maj 1
280 set req_min 5
282 if {[catch {set v [git --version]} err]} {
283 catch {wm withdraw .}
284 error_popup "Cannot determine Git version:
286 $err
288 [appname] requires Git $req_maj.$req_min or later."
289 exit 1
291 if {[regexp {^git version (\d+)\.(\d+)} $v _junk act_maj act_min]} {
292 if {$act_maj < $req_maj
293 || ($act_maj == $req_maj && $act_min < $req_min)} {
294 catch {wm withdraw .}
295 error_popup "[appname] requires Git $req_maj.$req_min or later.
297 You are using $v."
298 exit 1
300 } else {
301 catch {wm withdraw .}
302 error_popup "Cannot parse Git version string:\n\n$v"
303 exit 1
305 unset -nocomplain v _junk act_maj act_min req_maj req_min
307 ######################################################################
309 ## repository setup
311 if {[catch {
312 set _gitdir $env(GIT_DIR)
313 set _prefix {}
315 && [catch {
316 set _gitdir [git rev-parse --git-dir]
317 set _prefix [git rev-parse --show-prefix]
318 } err]} {
319 catch {wm withdraw .}
320 error_popup "Cannot find the git directory:\n\n$err"
321 exit 1
323 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
324 catch {set _gitdir [exec cygpath --unix $_gitdir]}
326 if {![file isdirectory $_gitdir]} {
327 catch {wm withdraw .}
328 error_popup "Git directory not found:\n\n$_gitdir"
329 exit 1
331 if {[lindex [file split $_gitdir] end] ne {.git}} {
332 catch {wm withdraw .}
333 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
334 exit 1
336 if {[catch {cd [file dirname $_gitdir]} err]} {
337 catch {wm withdraw .}
338 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
339 exit 1
341 set _reponame [lindex [file split \
342 [file normalize [file dirname $_gitdir]]] \
343 end]
345 ######################################################################
347 ## global init
349 set current_diff_path {}
350 set current_diff_side {}
351 set diff_actions [list]
352 set ui_status_value {Initializing...}
354 set HEAD {}
355 set PARENT {}
356 set MERGE_HEAD [list]
357 set commit_type {}
358 set empty_tree {}
359 set current_branch {}
360 set current_diff_path {}
361 set selected_commit_type new
363 ######################################################################
365 ## task management
367 set rescan_active 0
368 set diff_active 0
369 set last_clicked {}
371 set disable_on_lock [list]
372 set index_lock_type none
374 proc lock_index {type} {
375 global index_lock_type disable_on_lock
377 if {$index_lock_type eq {none}} {
378 set index_lock_type $type
379 foreach w $disable_on_lock {
380 uplevel #0 $w disabled
382 return 1
383 } elseif {$index_lock_type eq "begin-$type"} {
384 set index_lock_type $type
385 return 1
387 return 0
390 proc unlock_index {} {
391 global index_lock_type disable_on_lock
393 set index_lock_type none
394 foreach w $disable_on_lock {
395 uplevel #0 $w normal
399 ######################################################################
401 ## status
403 proc repository_state {ctvar hdvar mhvar} {
404 global current_branch
405 upvar $ctvar ct $hdvar hd $mhvar mh
407 set mh [list]
409 if {[catch {set current_branch [git symbolic-ref HEAD]}]} {
410 set current_branch {}
411 } else {
412 regsub ^refs/((heads|tags|remotes)/)? \
413 $current_branch \
414 {} \
415 current_branch
418 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
419 set hd {}
420 set ct initial
421 return
424 set merge_head [gitdir MERGE_HEAD]
425 if {[file exists $merge_head]} {
426 set ct merge
427 set fd_mh [open $merge_head r]
428 while {[gets $fd_mh line] >= 0} {
429 lappend mh $line
431 close $fd_mh
432 return
435 set ct normal
438 proc PARENT {} {
439 global PARENT empty_tree
441 set p [lindex $PARENT 0]
442 if {$p ne {}} {
443 return $p
445 if {$empty_tree eq {}} {
446 set empty_tree [git mktree << {}]
448 return $empty_tree
451 proc rescan {after {honor_trustmtime 1}} {
452 global HEAD PARENT MERGE_HEAD commit_type
453 global ui_index ui_workdir ui_status_value ui_comm
454 global rescan_active file_states
455 global repo_config
457 if {$rescan_active > 0 || ![lock_index read]} return
459 repository_state newType newHEAD newMERGE_HEAD
460 if {[string match amend* $commit_type]
461 && $newType eq {normal}
462 && $newHEAD eq $HEAD} {
463 } else {
464 set HEAD $newHEAD
465 set PARENT $newHEAD
466 set MERGE_HEAD $newMERGE_HEAD
467 set commit_type $newType
470 array unset file_states
472 if {![$ui_comm edit modified]
473 || [string trim [$ui_comm get 0.0 end]] eq {}} {
474 if {[load_message GITGUI_MSG]} {
475 } elseif {[load_message MERGE_MSG]} {
476 } elseif {[load_message SQUASH_MSG]} {
478 $ui_comm edit reset
479 $ui_comm edit modified false
482 if {[is_enabled branch]} {
483 load_all_heads
484 populate_branch_menu
487 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
488 rescan_stage2 {} $after
489 } else {
490 set rescan_active 1
491 set ui_status_value {Refreshing file status...}
492 set cmd [list git update-index]
493 lappend cmd -q
494 lappend cmd --unmerged
495 lappend cmd --ignore-missing
496 lappend cmd --refresh
497 set fd_rf [open "| $cmd" r]
498 fconfigure $fd_rf -blocking 0 -translation binary
499 fileevent $fd_rf readable \
500 [list rescan_stage2 $fd_rf $after]
504 proc rescan_stage2 {fd after} {
505 global ui_status_value
506 global rescan_active buf_rdi buf_rdf buf_rlo
508 if {$fd ne {}} {
509 read $fd
510 if {![eof $fd]} return
511 close $fd
514 set ls_others [list | git ls-files --others -z \
515 --exclude-per-directory=.gitignore]
516 set info_exclude [gitdir info exclude]
517 if {[file readable $info_exclude]} {
518 lappend ls_others "--exclude-from=$info_exclude"
521 set buf_rdi {}
522 set buf_rdf {}
523 set buf_rlo {}
525 set rescan_active 3
526 set ui_status_value {Scanning for modified files ...}
527 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
528 set fd_df [open "| git diff-files -z" r]
529 set fd_lo [open $ls_others r]
531 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
532 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
533 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
534 fileevent $fd_di readable [list read_diff_index $fd_di $after]
535 fileevent $fd_df readable [list read_diff_files $fd_df $after]
536 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
539 proc load_message {file} {
540 global ui_comm
542 set f [gitdir $file]
543 if {[file isfile $f]} {
544 if {[catch {set fd [open $f r]}]} {
545 return 0
547 set content [string trim [read $fd]]
548 close $fd
549 regsub -all -line {[ \r\t]+$} $content {} content
550 $ui_comm delete 0.0 end
551 $ui_comm insert end $content
552 return 1
554 return 0
557 proc read_diff_index {fd after} {
558 global buf_rdi
560 append buf_rdi [read $fd]
561 set c 0
562 set n [string length $buf_rdi]
563 while {$c < $n} {
564 set z1 [string first "\0" $buf_rdi $c]
565 if {$z1 == -1} break
566 incr z1
567 set z2 [string first "\0" $buf_rdi $z1]
568 if {$z2 == -1} break
570 incr c
571 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
572 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
573 merge_state \
574 [encoding convertfrom $p] \
575 [lindex $i 4]? \
576 [list [lindex $i 0] [lindex $i 2]] \
577 [list]
578 set c $z2
579 incr c
581 if {$c < $n} {
582 set buf_rdi [string range $buf_rdi $c end]
583 } else {
584 set buf_rdi {}
587 rescan_done $fd buf_rdi $after
590 proc read_diff_files {fd after} {
591 global buf_rdf
593 append buf_rdf [read $fd]
594 set c 0
595 set n [string length $buf_rdf]
596 while {$c < $n} {
597 set z1 [string first "\0" $buf_rdf $c]
598 if {$z1 == -1} break
599 incr z1
600 set z2 [string first "\0" $buf_rdf $z1]
601 if {$z2 == -1} break
603 incr c
604 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
605 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
606 merge_state \
607 [encoding convertfrom $p] \
608 ?[lindex $i 4] \
609 [list] \
610 [list [lindex $i 0] [lindex $i 2]]
611 set c $z2
612 incr c
614 if {$c < $n} {
615 set buf_rdf [string range $buf_rdf $c end]
616 } else {
617 set buf_rdf {}
620 rescan_done $fd buf_rdf $after
623 proc read_ls_others {fd after} {
624 global buf_rlo
626 append buf_rlo [read $fd]
627 set pck [split $buf_rlo "\0"]
628 set buf_rlo [lindex $pck end]
629 foreach p [lrange $pck 0 end-1] {
630 merge_state [encoding convertfrom $p] ?O
632 rescan_done $fd buf_rlo $after
635 proc rescan_done {fd buf after} {
636 global rescan_active current_diff_path
637 global file_states repo_config
638 upvar $buf to_clear
640 if {![eof $fd]} return
641 set to_clear {}
642 close $fd
643 if {[incr rescan_active -1] > 0} return
645 prune_selection
646 unlock_index
647 display_all_files
648 if {$current_diff_path ne {}} reshow_diff
649 uplevel #0 $after
652 proc prune_selection {} {
653 global file_states selected_paths
655 foreach path [array names selected_paths] {
656 if {[catch {set still_here $file_states($path)}]} {
657 unset selected_paths($path)
662 ######################################################################
664 ## ui helpers
666 proc mapicon {w state path} {
667 global all_icons
669 if {[catch {set r $all_icons($state$w)}]} {
670 puts "error: no icon for $w state={$state} $path"
671 return file_plain
673 return $r
676 proc mapdesc {state path} {
677 global all_descs
679 if {[catch {set r $all_descs($state)}]} {
680 puts "error: no desc for state={$state} $path"
681 return $state
683 return $r
686 proc escape_path {path} {
687 regsub -all {\\} $path "\\\\" path
688 regsub -all "\n" $path "\\n" path
689 return $path
692 proc short_path {path} {
693 return [escape_path [lindex [file split $path] end]]
696 set next_icon_id 0
697 set null_sha1 [string repeat 0 40]
699 proc merge_state {path new_state {head_info {}} {index_info {}}} {
700 global file_states next_icon_id null_sha1
702 set s0 [string index $new_state 0]
703 set s1 [string index $new_state 1]
705 if {[catch {set info $file_states($path)}]} {
706 set state __
707 set icon n[incr next_icon_id]
708 } else {
709 set state [lindex $info 0]
710 set icon [lindex $info 1]
711 if {$head_info eq {}} {set head_info [lindex $info 2]}
712 if {$index_info eq {}} {set index_info [lindex $info 3]}
715 if {$s0 eq {?}} {set s0 [string index $state 0]} \
716 elseif {$s0 eq {_}} {set s0 _}
718 if {$s1 eq {?}} {set s1 [string index $state 1]} \
719 elseif {$s1 eq {_}} {set s1 _}
721 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
722 set head_info [list 0 $null_sha1]
723 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
724 && $head_info eq {}} {
725 set head_info $index_info
728 set file_states($path) [list $s0$s1 $icon \
729 $head_info $index_info \
731 return $state
734 proc display_file_helper {w path icon_name old_m new_m} {
735 global file_lists
737 if {$new_m eq {_}} {
738 set lno [lsearch -sorted -exact $file_lists($w) $path]
739 if {$lno >= 0} {
740 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
741 incr lno
742 $w conf -state normal
743 $w delete $lno.0 [expr {$lno + 1}].0
744 $w conf -state disabled
746 } elseif {$old_m eq {_} && $new_m ne {_}} {
747 lappend file_lists($w) $path
748 set file_lists($w) [lsort -unique $file_lists($w)]
749 set lno [lsearch -sorted -exact $file_lists($w) $path]
750 incr lno
751 $w conf -state normal
752 $w image create $lno.0 \
753 -align center -padx 5 -pady 1 \
754 -name $icon_name \
755 -image [mapicon $w $new_m $path]
756 $w insert $lno.1 "[escape_path $path]\n"
757 $w conf -state disabled
758 } elseif {$old_m ne $new_m} {
759 $w conf -state normal
760 $w image conf $icon_name -image [mapicon $w $new_m $path]
761 $w conf -state disabled
765 proc display_file {path state} {
766 global file_states selected_paths
767 global ui_index ui_workdir
769 set old_m [merge_state $path $state]
770 set s $file_states($path)
771 set new_m [lindex $s 0]
772 set icon_name [lindex $s 1]
774 set o [string index $old_m 0]
775 set n [string index $new_m 0]
776 if {$o eq {U}} {
777 set o _
779 if {$n eq {U}} {
780 set n _
782 display_file_helper $ui_index $path $icon_name $o $n
784 if {[string index $old_m 0] eq {U}} {
785 set o U
786 } else {
787 set o [string index $old_m 1]
789 if {[string index $new_m 0] eq {U}} {
790 set n U
791 } else {
792 set n [string index $new_m 1]
794 display_file_helper $ui_workdir $path $icon_name $o $n
796 if {$new_m eq {__}} {
797 unset file_states($path)
798 catch {unset selected_paths($path)}
802 proc display_all_files_helper {w path icon_name m} {
803 global file_lists
805 lappend file_lists($w) $path
806 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
807 $w image create end \
808 -align center -padx 5 -pady 1 \
809 -name $icon_name \
810 -image [mapicon $w $m $path]
811 $w insert end "[escape_path $path]\n"
814 proc display_all_files {} {
815 global ui_index ui_workdir
816 global file_states file_lists
817 global last_clicked
819 $ui_index conf -state normal
820 $ui_workdir conf -state normal
822 $ui_index delete 0.0 end
823 $ui_workdir delete 0.0 end
824 set last_clicked {}
826 set file_lists($ui_index) [list]
827 set file_lists($ui_workdir) [list]
829 foreach path [lsort [array names file_states]] {
830 set s $file_states($path)
831 set m [lindex $s 0]
832 set icon_name [lindex $s 1]
834 set s [string index $m 0]
835 if {$s ne {U} && $s ne {_}} {
836 display_all_files_helper $ui_index $path \
837 $icon_name $s
840 if {[string index $m 0] eq {U}} {
841 set s U
842 } else {
843 set s [string index $m 1]
845 if {$s ne {_}} {
846 display_all_files_helper $ui_workdir $path \
847 $icon_name $s
851 $ui_index conf -state disabled
852 $ui_workdir conf -state disabled
855 ######################################################################
857 ## icons
859 set filemask {
860 #define mask_width 14
861 #define mask_height 15
862 static unsigned char mask_bits[] = {
863 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
864 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
865 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
868 image create bitmap file_plain -background white -foreground black -data {
869 #define plain_width 14
870 #define plain_height 15
871 static unsigned char plain_bits[] = {
872 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
873 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
874 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
875 } -maskdata $filemask
877 image create bitmap file_mod -background white -foreground blue -data {
878 #define mod_width 14
879 #define mod_height 15
880 static unsigned char mod_bits[] = {
881 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
882 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
883 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
884 } -maskdata $filemask
886 image create bitmap file_fulltick -background white -foreground "#007000" -data {
887 #define file_fulltick_width 14
888 #define file_fulltick_height 15
889 static unsigned char file_fulltick_bits[] = {
890 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
891 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
892 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
893 } -maskdata $filemask
895 image create bitmap file_parttick -background white -foreground "#005050" -data {
896 #define parttick_width 14
897 #define parttick_height 15
898 static unsigned char parttick_bits[] = {
899 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
900 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
901 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
902 } -maskdata $filemask
904 image create bitmap file_question -background white -foreground black -data {
905 #define file_question_width 14
906 #define file_question_height 15
907 static unsigned char file_question_bits[] = {
908 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
909 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
910 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
911 } -maskdata $filemask
913 image create bitmap file_removed -background white -foreground red -data {
914 #define file_removed_width 14
915 #define file_removed_height 15
916 static unsigned char file_removed_bits[] = {
917 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
918 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
919 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
920 } -maskdata $filemask
922 image create bitmap file_merge -background white -foreground blue -data {
923 #define file_merge_width 14
924 #define file_merge_height 15
925 static unsigned char file_merge_bits[] = {
926 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
927 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
928 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
929 } -maskdata $filemask
931 set file_dir_data {
932 #define file_width 18
933 #define file_height 18
934 static unsigned char file_bits[] = {
935 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
936 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
937 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
938 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
939 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
941 image create bitmap file_dir -background white -foreground blue \
942 -data $file_dir_data -maskdata $file_dir_data
943 unset file_dir_data
945 set file_uplevel_data {
946 #define up_width 15
947 #define up_height 15
948 static unsigned char up_bits[] = {
949 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
950 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
951 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
953 image create bitmap file_uplevel -background white -foreground red \
954 -data $file_uplevel_data -maskdata $file_uplevel_data
955 unset file_uplevel_data
957 set ui_index .vpane.files.index.list
958 set ui_workdir .vpane.files.workdir.list
960 set all_icons(_$ui_index) file_plain
961 set all_icons(A$ui_index) file_fulltick
962 set all_icons(M$ui_index) file_fulltick
963 set all_icons(D$ui_index) file_removed
964 set all_icons(U$ui_index) file_merge
966 set all_icons(_$ui_workdir) file_plain
967 set all_icons(M$ui_workdir) file_mod
968 set all_icons(D$ui_workdir) file_question
969 set all_icons(U$ui_workdir) file_merge
970 set all_icons(O$ui_workdir) file_plain
972 set max_status_desc 0
973 foreach i {
974 {__ "Unmodified"}
976 {_M "Modified, not staged"}
977 {M_ "Staged for commit"}
978 {MM "Portions staged for commit"}
979 {MD "Staged for commit, missing"}
981 {_O "Untracked, not staged"}
982 {A_ "Staged for commit"}
983 {AM "Portions staged for commit"}
984 {AD "Staged for commit, missing"}
986 {_D "Missing"}
987 {D_ "Staged for removal"}
988 {DO "Staged for removal, still present"}
990 {U_ "Requires merge resolution"}
991 {UU "Requires merge resolution"}
992 {UM "Requires merge resolution"}
993 {UD "Requires merge resolution"}
995 if {$max_status_desc < [string length [lindex $i 1]]} {
996 set max_status_desc [string length [lindex $i 1]]
998 set all_descs([lindex $i 0]) [lindex $i 1]
1000 unset i
1002 ######################################################################
1004 ## util
1006 proc bind_button3 {w cmd} {
1007 bind $w <Any-Button-3> $cmd
1008 if {[is_MacOSX]} {
1009 bind $w <Control-Button-1> $cmd
1013 proc scrollbar2many {list mode args} {
1014 foreach w $list {eval $w $mode $args}
1017 proc many2scrollbar {list mode sb top bottom} {
1018 $sb set $top $bottom
1019 foreach w $list {$w $mode moveto $top}
1022 proc incr_font_size {font {amt 1}} {
1023 set sz [font configure $font -size]
1024 incr sz $amt
1025 font configure $font -size $sz
1026 font configure ${font}bold -size $sz
1029 ######################################################################
1031 ## ui commands
1033 set starting_gitk_msg {Starting gitk... please wait...}
1035 proc do_gitk {revs} {
1036 global env ui_status_value starting_gitk_msg
1038 # -- Always start gitk through whatever we were loaded with. This
1039 # lets us bypass using shell process on Windows systems.
1041 set cmd [list [info nameofexecutable]]
1042 lappend cmd [gitexec gitk]
1043 if {$revs ne {}} {
1044 append cmd { }
1045 append cmd $revs
1048 if {[catch {eval exec $cmd &} err]} {
1049 error_popup "Failed to start gitk:\n\n$err"
1050 } else {
1051 set ui_status_value $starting_gitk_msg
1052 after 10000 {
1053 if {$ui_status_value eq $starting_gitk_msg} {
1054 set ui_status_value {Ready.}
1060 set is_quitting 0
1062 proc do_quit {} {
1063 global ui_comm is_quitting repo_config commit_type
1065 if {$is_quitting} return
1066 set is_quitting 1
1068 if {[winfo exists $ui_comm]} {
1069 # -- Stash our current commit buffer.
1071 set save [gitdir GITGUI_MSG]
1072 set msg [string trim [$ui_comm get 0.0 end]]
1073 regsub -all -line {[ \r\t]+$} $msg {} msg
1074 if {(![string match amend* $commit_type]
1075 || [$ui_comm edit modified])
1076 && $msg ne {}} {
1077 catch {
1078 set fd [open $save w]
1079 puts -nonewline $fd $msg
1080 close $fd
1082 } else {
1083 catch {file delete $save}
1086 # -- Stash our current window geometry into this repository.
1088 set cfg_geometry [list]
1089 lappend cfg_geometry [wm geometry .]
1090 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1091 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1092 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1093 set rc_geometry {}
1095 if {$cfg_geometry ne $rc_geometry} {
1096 catch {git config gui.geometry $cfg_geometry}
1100 destroy .
1103 proc do_rescan {} {
1104 rescan {set ui_status_value {Ready.}}
1107 proc do_commit {} {
1108 commit_tree
1111 proc toggle_or_diff {w x y} {
1112 global file_states file_lists current_diff_path ui_index ui_workdir
1113 global last_clicked selected_paths
1115 set pos [split [$w index @$x,$y] .]
1116 set lno [lindex $pos 0]
1117 set col [lindex $pos 1]
1118 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1119 if {$path eq {}} {
1120 set last_clicked {}
1121 return
1124 set last_clicked [list $w $lno]
1125 array unset selected_paths
1126 $ui_index tag remove in_sel 0.0 end
1127 $ui_workdir tag remove in_sel 0.0 end
1129 if {$col == 0} {
1130 if {$current_diff_path eq $path} {
1131 set after {reshow_diff;}
1132 } else {
1133 set after {}
1135 if {$w eq $ui_index} {
1136 update_indexinfo \
1137 "Unstaging [short_path $path] from commit" \
1138 [list $path] \
1139 [concat $after {set ui_status_value {Ready.}}]
1140 } elseif {$w eq $ui_workdir} {
1141 update_index \
1142 "Adding [short_path $path]" \
1143 [list $path] \
1144 [concat $after {set ui_status_value {Ready.}}]
1146 } else {
1147 show_diff $path $w $lno
1151 proc add_one_to_selection {w x y} {
1152 global file_lists last_clicked selected_paths
1154 set lno [lindex [split [$w index @$x,$y] .] 0]
1155 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1156 if {$path eq {}} {
1157 set last_clicked {}
1158 return
1161 if {$last_clicked ne {}
1162 && [lindex $last_clicked 0] ne $w} {
1163 array unset selected_paths
1164 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1167 set last_clicked [list $w $lno]
1168 if {[catch {set in_sel $selected_paths($path)}]} {
1169 set in_sel 0
1171 if {$in_sel} {
1172 unset selected_paths($path)
1173 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1174 } else {
1175 set selected_paths($path) 1
1176 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1180 proc add_range_to_selection {w x y} {
1181 global file_lists last_clicked selected_paths
1183 if {[lindex $last_clicked 0] ne $w} {
1184 toggle_or_diff $w $x $y
1185 return
1188 set lno [lindex [split [$w index @$x,$y] .] 0]
1189 set lc [lindex $last_clicked 1]
1190 if {$lc < $lno} {
1191 set begin $lc
1192 set end $lno
1193 } else {
1194 set begin $lno
1195 set end $lc
1198 foreach path [lrange $file_lists($w) \
1199 [expr {$begin - 1}] \
1200 [expr {$end - 1}]] {
1201 set selected_paths($path) 1
1203 $w tag add in_sel $begin.0 [expr {$end + 1}].0
1206 ######################################################################
1208 ## config defaults
1210 set cursor_ptr arrow
1211 font create font_diff -family Courier -size 10
1212 font create font_ui
1213 catch {
1214 label .dummy
1215 eval font configure font_ui [font actual [.dummy cget -font]]
1216 destroy .dummy
1219 font create font_uibold
1220 font create font_diffbold
1222 foreach class {Button Checkbutton Entry Label
1223 Labelframe Listbox Menu Message
1224 Radiobutton Spinbox Text} {
1225 option add *$class.font font_ui
1227 unset class
1229 if {[is_MacOSX]} {
1230 set M1B M1
1231 set M1T Cmd
1232 } else {
1233 set M1B Control
1234 set M1T Ctrl
1237 proc apply_config {} {
1238 global repo_config font_descs
1240 foreach option $font_descs {
1241 set name [lindex $option 0]
1242 set font [lindex $option 1]
1243 if {[catch {
1244 foreach {cn cv} $repo_config(gui.$name) {
1245 font configure $font $cn $cv
1247 } err]} {
1248 error_popup "Invalid font specified in gui.$name:\n\n$err"
1250 foreach {cn cv} [font configure $font] {
1251 font configure ${font}bold $cn $cv
1253 font configure ${font}bold -weight bold
1257 set default_config(merge.summary) false
1258 set default_config(merge.verbosity) 2
1259 set default_config(user.name) {}
1260 set default_config(user.email) {}
1262 set default_config(gui.trustmtime) false
1263 set default_config(gui.diffcontext) 5
1264 set default_config(gui.newbranchtemplate) {}
1265 set default_config(gui.fontui) [font configure font_ui]
1266 set default_config(gui.fontdiff) [font configure font_diff]
1267 set font_descs {
1268 {fontui font_ui {Main Font}}
1269 {fontdiff font_diff {Diff/Console Font}}
1271 load_config 0
1272 apply_config
1274 ######################################################################
1276 ## feature option selection
1278 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
1279 unset _junk
1280 } else {
1281 set subcommand gui
1283 if {$subcommand eq {gui.sh}} {
1284 set subcommand gui
1286 if {$subcommand eq {gui} && [llength $argv] > 0} {
1287 set subcommand [lindex $argv 0]
1288 set argv [lrange $argv 1 end]
1291 enable_option multicommit
1292 enable_option branch
1293 enable_option transport
1295 switch -- $subcommand {
1296 browser -
1297 blame {
1298 disable_option multicommit
1299 disable_option branch
1300 disable_option transport
1302 citool {
1303 enable_option singlecommit
1305 disable_option multicommit
1306 disable_option branch
1307 disable_option transport
1311 ######################################################################
1313 ## ui construction
1315 set ui_comm {}
1317 # -- Menu Bar
1319 menu .mbar -tearoff 0
1320 .mbar add cascade -label Repository -menu .mbar.repository
1321 .mbar add cascade -label Edit -menu .mbar.edit
1322 if {[is_enabled branch]} {
1323 .mbar add cascade -label Branch -menu .mbar.branch
1325 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1326 .mbar add cascade -label Commit -menu .mbar.commit
1328 if {[is_enabled transport]} {
1329 .mbar add cascade -label Merge -menu .mbar.merge
1330 .mbar add cascade -label Fetch -menu .mbar.fetch
1331 .mbar add cascade -label Push -menu .mbar.push
1333 . configure -menu .mbar
1335 # -- Repository Menu
1337 menu .mbar.repository
1339 .mbar.repository add command \
1340 -label {Browse Current Branch} \
1341 -command {browser::new $current_branch}
1342 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1343 .mbar.repository add separator
1345 .mbar.repository add command \
1346 -label {Visualize Current Branch} \
1347 -command {do_gitk $current_branch}
1348 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1349 .mbar.repository add command \
1350 -label {Visualize All Branches} \
1351 -command {do_gitk --all}
1352 .mbar.repository add separator
1354 if {[is_enabled multicommit]} {
1355 .mbar.repository add command -label {Database Statistics} \
1356 -command do_stats
1358 .mbar.repository add command -label {Compress Database} \
1359 -command do_gc
1361 .mbar.repository add command -label {Verify Database} \
1362 -command do_fsck_objects
1364 .mbar.repository add separator
1366 if {[is_Cygwin]} {
1367 .mbar.repository add command \
1368 -label {Create Desktop Icon} \
1369 -command do_cygwin_shortcut
1370 } elseif {[is_Windows]} {
1371 .mbar.repository add command \
1372 -label {Create Desktop Icon} \
1373 -command do_windows_shortcut
1374 } elseif {[is_MacOSX]} {
1375 .mbar.repository add command \
1376 -label {Create Desktop Icon} \
1377 -command do_macosx_app
1381 .mbar.repository add command -label Quit \
1382 -command do_quit \
1383 -accelerator $M1T-Q
1385 # -- Edit Menu
1387 menu .mbar.edit
1388 .mbar.edit add command -label Undo \
1389 -command {catch {[focus] edit undo}} \
1390 -accelerator $M1T-Z
1391 .mbar.edit add command -label Redo \
1392 -command {catch {[focus] edit redo}} \
1393 -accelerator $M1T-Y
1394 .mbar.edit add separator
1395 .mbar.edit add command -label Cut \
1396 -command {catch {tk_textCut [focus]}} \
1397 -accelerator $M1T-X
1398 .mbar.edit add command -label Copy \
1399 -command {catch {tk_textCopy [focus]}} \
1400 -accelerator $M1T-C
1401 .mbar.edit add command -label Paste \
1402 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1403 -accelerator $M1T-V
1404 .mbar.edit add command -label Delete \
1405 -command {catch {[focus] delete sel.first sel.last}} \
1406 -accelerator Del
1407 .mbar.edit add separator
1408 .mbar.edit add command -label {Select All} \
1409 -command {catch {[focus] tag add sel 0.0 end}} \
1410 -accelerator $M1T-A
1412 # -- Branch Menu
1414 if {[is_enabled branch]} {
1415 menu .mbar.branch
1417 .mbar.branch add command -label {Create...} \
1418 -command do_create_branch \
1419 -accelerator $M1T-N
1420 lappend disable_on_lock [list .mbar.branch entryconf \
1421 [.mbar.branch index last] -state]
1423 .mbar.branch add command -label {Delete...} \
1424 -command do_delete_branch
1425 lappend disable_on_lock [list .mbar.branch entryconf \
1426 [.mbar.branch index last] -state]
1428 .mbar.branch add command -label {Reset...} \
1429 -command merge::reset_hard
1430 lappend disable_on_lock [list .mbar.branch entryconf \
1431 [.mbar.branch index last] -state]
1434 # -- Commit Menu
1436 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1437 menu .mbar.commit
1439 .mbar.commit add radiobutton \
1440 -label {New Commit} \
1441 -command do_select_commit_type \
1442 -variable selected_commit_type \
1443 -value new
1444 lappend disable_on_lock \
1445 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1447 .mbar.commit add radiobutton \
1448 -label {Amend Last Commit} \
1449 -command do_select_commit_type \
1450 -variable selected_commit_type \
1451 -value amend
1452 lappend disable_on_lock \
1453 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1455 .mbar.commit add separator
1457 .mbar.commit add command -label Rescan \
1458 -command do_rescan \
1459 -accelerator F5
1460 lappend disable_on_lock \
1461 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1463 .mbar.commit add command -label {Add To Commit} \
1464 -command do_add_selection
1465 lappend disable_on_lock \
1466 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1468 .mbar.commit add command -label {Add Existing To Commit} \
1469 -command do_add_all \
1470 -accelerator $M1T-I
1471 lappend disable_on_lock \
1472 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1474 .mbar.commit add command -label {Unstage From Commit} \
1475 -command do_unstage_selection
1476 lappend disable_on_lock \
1477 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1479 .mbar.commit add command -label {Revert Changes} \
1480 -command do_revert_selection
1481 lappend disable_on_lock \
1482 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1484 .mbar.commit add separator
1486 .mbar.commit add command -label {Sign Off} \
1487 -command do_signoff \
1488 -accelerator $M1T-S
1490 .mbar.commit add command -label Commit \
1491 -command do_commit \
1492 -accelerator $M1T-Return
1493 lappend disable_on_lock \
1494 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1497 # -- Merge Menu
1499 if {[is_enabled branch]} {
1500 menu .mbar.merge
1501 .mbar.merge add command -label {Local Merge...} \
1502 -command merge::dialog
1503 lappend disable_on_lock \
1504 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1505 .mbar.merge add command -label {Abort Merge...} \
1506 -command merge::reset_hard
1507 lappend disable_on_lock \
1508 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1512 # -- Transport Menu
1514 if {[is_enabled transport]} {
1515 menu .mbar.fetch
1517 menu .mbar.push
1518 .mbar.push add command -label {Push...} \
1519 -command do_push_anywhere
1522 if {[is_MacOSX]} {
1523 # -- Apple Menu (Mac OS X only)
1525 .mbar add cascade -label Apple -menu .mbar.apple
1526 menu .mbar.apple
1528 .mbar.apple add command -label "About [appname]" \
1529 -command do_about
1530 .mbar.apple add command -label "Options..." \
1531 -command do_options
1532 } else {
1533 # -- Edit Menu
1535 .mbar.edit add separator
1536 .mbar.edit add command -label {Options...} \
1537 -command do_options
1539 # -- Tools Menu
1541 if {[file exists /usr/local/miga/lib/gui-miga]
1542 && [file exists .pvcsrc]} {
1543 proc do_miga {} {
1544 global ui_status_value
1545 if {![lock_index update]} return
1546 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
1547 set miga_fd [open "|$cmd" r]
1548 fconfigure $miga_fd -blocking 0
1549 fileevent $miga_fd readable [list miga_done $miga_fd]
1550 set ui_status_value {Running miga...}
1552 proc miga_done {fd} {
1553 read $fd 512
1554 if {[eof $fd]} {
1555 close $fd
1556 unlock_index
1557 rescan [list set ui_status_value {Ready.}]
1560 .mbar add cascade -label Tools -menu .mbar.tools
1561 menu .mbar.tools
1562 .mbar.tools add command -label "Migrate" \
1563 -command do_miga
1564 lappend disable_on_lock \
1565 [list .mbar.tools entryconf [.mbar.tools index last] -state]
1569 # -- Help Menu
1571 .mbar add cascade -label Help -menu .mbar.help
1572 menu .mbar.help
1574 if {![is_MacOSX]} {
1575 .mbar.help add command -label "About [appname]" \
1576 -command do_about
1579 set browser {}
1580 catch {set browser $repo_config(instaweb.browser)}
1581 set doc_path [file dirname [gitexec]]
1582 set doc_path [file join $doc_path Documentation index.html]
1584 if {[is_Cygwin]} {
1585 set doc_path [exec cygpath --mixed $doc_path]
1588 if {$browser eq {}} {
1589 if {[is_MacOSX]} {
1590 set browser open
1591 } elseif {[is_Cygwin]} {
1592 set program_files [file dirname [exec cygpath --windir]]
1593 set program_files [file join $program_files {Program Files}]
1594 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1595 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1596 if {[file exists $firefox]} {
1597 set browser $firefox
1598 } elseif {[file exists $ie]} {
1599 set browser $ie
1601 unset program_files firefox ie
1605 if {[file isfile $doc_path]} {
1606 set doc_url "file:$doc_path"
1607 } else {
1608 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1611 if {$browser ne {}} {
1612 .mbar.help add command -label {Online Documentation} \
1613 -command [list exec $browser $doc_url &]
1615 unset browser doc_path doc_url
1617 # -- Standard bindings
1619 bind . <Destroy> {if {{%W} eq {.}} do_quit}
1620 bind all <$M1B-Key-q> do_quit
1621 bind all <$M1B-Key-Q> do_quit
1622 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1623 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1625 set subcommand_args {}
1626 proc usage {} {
1627 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1628 exit 1
1631 # -- Not a normal commit type invocation? Do that instead!
1633 switch -- $subcommand {
1634 browser {
1635 set subcommand_args {rev?}
1636 switch [llength $argv] {
1638 set current_branch [git symbolic-ref HEAD]
1639 regsub ^refs/((heads|tags|remotes)/)? \
1640 $current_branch {} current_branch
1643 set current_branch [lindex $argv 0]
1645 default usage
1647 browser::new $current_branch
1648 return
1650 blame {
1651 set subcommand_args {rev? path?}
1652 set head {}
1653 set path {}
1654 set is_path 0
1655 foreach a $argv {
1656 if {$is_path || [file exists $_prefix$a]} {
1657 if {$path ne {}} usage
1658 set path $_prefix$a
1659 break
1660 } elseif {$a eq {--}} {
1661 if {$path ne {}} {
1662 if {$head ne {}} usage
1663 set head $path
1664 set path {}
1666 set is_path 1
1667 } elseif {$head eq {}} {
1668 if {$head ne {}} usage
1669 set head $a
1670 } else {
1671 usage
1674 unset is_path
1676 if {$head eq {}} {
1677 set current_branch [git symbolic-ref HEAD]
1678 regsub ^refs/((heads|tags|remotes)/)? \
1679 $current_branch {} current_branch
1680 } else {
1681 set current_branch $head
1684 if {$path eq {}} usage
1685 blame::new $head $path
1686 return
1688 citool -
1689 gui {
1690 if {[llength $argv] != 0} {
1691 puts -nonewline stderr "usage: $argv0"
1692 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
1693 puts -nonewline stderr " $subcommand"
1695 puts stderr {}
1696 exit 1
1698 # fall through to setup UI for commits
1700 default {
1701 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
1702 exit 1
1706 # -- Branch Control
1708 frame .branch \
1709 -borderwidth 1 \
1710 -relief sunken
1711 label .branch.l1 \
1712 -text {Current Branch:} \
1713 -anchor w \
1714 -justify left
1715 label .branch.cb \
1716 -textvariable current_branch \
1717 -anchor w \
1718 -justify left
1719 pack .branch.l1 -side left
1720 pack .branch.cb -side left -fill x
1721 pack .branch -side top -fill x
1723 # -- Main Window Layout
1725 panedwindow .vpane -orient vertical
1726 panedwindow .vpane.files -orient horizontal
1727 .vpane add .vpane.files -sticky nsew -height 100 -width 200
1728 pack .vpane -anchor n -side top -fill both -expand 1
1730 # -- Index File List
1732 frame .vpane.files.index -height 100 -width 200
1733 label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
1734 -background green
1735 text $ui_index -background white -borderwidth 0 \
1736 -width 20 -height 10 \
1737 -wrap none \
1738 -cursor $cursor_ptr \
1739 -xscrollcommand {.vpane.files.index.sx set} \
1740 -yscrollcommand {.vpane.files.index.sy set} \
1741 -state disabled
1742 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
1743 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
1744 pack .vpane.files.index.title -side top -fill x
1745 pack .vpane.files.index.sx -side bottom -fill x
1746 pack .vpane.files.index.sy -side right -fill y
1747 pack $ui_index -side left -fill both -expand 1
1748 .vpane.files add .vpane.files.index -sticky nsew
1750 # -- Working Directory File List
1752 frame .vpane.files.workdir -height 100 -width 200
1753 label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
1754 -background red
1755 text $ui_workdir -background white -borderwidth 0 \
1756 -width 20 -height 10 \
1757 -wrap none \
1758 -cursor $cursor_ptr \
1759 -xscrollcommand {.vpane.files.workdir.sx set} \
1760 -yscrollcommand {.vpane.files.workdir.sy set} \
1761 -state disabled
1762 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
1763 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
1764 pack .vpane.files.workdir.title -side top -fill x
1765 pack .vpane.files.workdir.sx -side bottom -fill x
1766 pack .vpane.files.workdir.sy -side right -fill y
1767 pack $ui_workdir -side left -fill both -expand 1
1768 .vpane.files add .vpane.files.workdir -sticky nsew
1770 foreach i [list $ui_index $ui_workdir] {
1771 $i tag conf in_diff -font font_uibold
1772 $i tag conf in_sel \
1773 -background [$i cget -foreground] \
1774 -foreground [$i cget -background]
1776 unset i
1778 # -- Diff and Commit Area
1780 frame .vpane.lower -height 300 -width 400
1781 frame .vpane.lower.commarea
1782 frame .vpane.lower.diff -relief sunken -borderwidth 1
1783 pack .vpane.lower.commarea -side top -fill x
1784 pack .vpane.lower.diff -side bottom -fill both -expand 1
1785 .vpane add .vpane.lower -sticky nsew
1787 # -- Commit Area Buttons
1789 frame .vpane.lower.commarea.buttons
1790 label .vpane.lower.commarea.buttons.l -text {} \
1791 -anchor w \
1792 -justify left
1793 pack .vpane.lower.commarea.buttons.l -side top -fill x
1794 pack .vpane.lower.commarea.buttons -side left -fill y
1796 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1797 -command do_rescan
1798 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1799 lappend disable_on_lock \
1800 {.vpane.lower.commarea.buttons.rescan conf -state}
1802 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
1803 -command do_add_all
1804 pack .vpane.lower.commarea.buttons.incall -side top -fill x
1805 lappend disable_on_lock \
1806 {.vpane.lower.commarea.buttons.incall conf -state}
1808 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1809 -command do_signoff
1810 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1812 button .vpane.lower.commarea.buttons.commit -text {Commit} \
1813 -command do_commit
1814 pack .vpane.lower.commarea.buttons.commit -side top -fill x
1815 lappend disable_on_lock \
1816 {.vpane.lower.commarea.buttons.commit conf -state}
1818 # -- Commit Message Buffer
1820 frame .vpane.lower.commarea.buffer
1821 frame .vpane.lower.commarea.buffer.header
1822 set ui_comm .vpane.lower.commarea.buffer.t
1823 set ui_coml .vpane.lower.commarea.buffer.header.l
1824 radiobutton .vpane.lower.commarea.buffer.header.new \
1825 -text {New Commit} \
1826 -command do_select_commit_type \
1827 -variable selected_commit_type \
1828 -value new
1829 lappend disable_on_lock \
1830 [list .vpane.lower.commarea.buffer.header.new conf -state]
1831 radiobutton .vpane.lower.commarea.buffer.header.amend \
1832 -text {Amend Last Commit} \
1833 -command do_select_commit_type \
1834 -variable selected_commit_type \
1835 -value amend
1836 lappend disable_on_lock \
1837 [list .vpane.lower.commarea.buffer.header.amend conf -state]
1838 label $ui_coml \
1839 -anchor w \
1840 -justify left
1841 proc trace_commit_type {varname args} {
1842 global ui_coml commit_type
1843 switch -glob -- $commit_type {
1844 initial {set txt {Initial Commit Message:}}
1845 amend {set txt {Amended Commit Message:}}
1846 amend-initial {set txt {Amended Initial Commit Message:}}
1847 amend-merge {set txt {Amended Merge Commit Message:}}
1848 merge {set txt {Merge Commit Message:}}
1849 * {set txt {Commit Message:}}
1851 $ui_coml conf -text $txt
1853 trace add variable commit_type write trace_commit_type
1854 pack $ui_coml -side left -fill x
1855 pack .vpane.lower.commarea.buffer.header.amend -side right
1856 pack .vpane.lower.commarea.buffer.header.new -side right
1858 text $ui_comm -background white -borderwidth 1 \
1859 -undo true \
1860 -maxundo 20 \
1861 -autoseparators true \
1862 -relief sunken \
1863 -width 75 -height 9 -wrap none \
1864 -font font_diff \
1865 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
1866 scrollbar .vpane.lower.commarea.buffer.sby \
1867 -command [list $ui_comm yview]
1868 pack .vpane.lower.commarea.buffer.header -side top -fill x
1869 pack .vpane.lower.commarea.buffer.sby -side right -fill y
1870 pack $ui_comm -side left -fill y
1871 pack .vpane.lower.commarea.buffer -side left -fill y
1873 # -- Commit Message Buffer Context Menu
1875 set ctxm .vpane.lower.commarea.buffer.ctxm
1876 menu $ctxm -tearoff 0
1877 $ctxm add command \
1878 -label {Cut} \
1879 -command {tk_textCut $ui_comm}
1880 $ctxm add command \
1881 -label {Copy} \
1882 -command {tk_textCopy $ui_comm}
1883 $ctxm add command \
1884 -label {Paste} \
1885 -command {tk_textPaste $ui_comm}
1886 $ctxm add command \
1887 -label {Delete} \
1888 -command {$ui_comm delete sel.first sel.last}
1889 $ctxm add separator
1890 $ctxm add command \
1891 -label {Select All} \
1892 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
1893 $ctxm add command \
1894 -label {Copy All} \
1895 -command {
1896 $ui_comm tag add sel 0.0 end
1897 tk_textCopy $ui_comm
1898 $ui_comm tag remove sel 0.0 end
1900 $ctxm add separator
1901 $ctxm add command \
1902 -label {Sign Off} \
1903 -command do_signoff
1904 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
1906 # -- Diff Header
1908 proc trace_current_diff_path {varname args} {
1909 global current_diff_path diff_actions file_states
1910 if {$current_diff_path eq {}} {
1911 set s {}
1912 set f {}
1913 set p {}
1914 set o disabled
1915 } else {
1916 set p $current_diff_path
1917 set s [mapdesc [lindex $file_states($p) 0] $p]
1918 set f {File:}
1919 set p [escape_path $p]
1920 set o normal
1923 .vpane.lower.diff.header.status configure -text $s
1924 .vpane.lower.diff.header.file configure -text $f
1925 .vpane.lower.diff.header.path configure -text $p
1926 foreach w $diff_actions {
1927 uplevel #0 $w $o
1930 trace add variable current_diff_path write trace_current_diff_path
1932 frame .vpane.lower.diff.header -background orange
1933 label .vpane.lower.diff.header.status \
1934 -background orange \
1935 -width $max_status_desc \
1936 -anchor w \
1937 -justify left
1938 label .vpane.lower.diff.header.file \
1939 -background orange \
1940 -anchor w \
1941 -justify left
1942 label .vpane.lower.diff.header.path \
1943 -background orange \
1944 -anchor w \
1945 -justify left
1946 pack .vpane.lower.diff.header.status -side left
1947 pack .vpane.lower.diff.header.file -side left
1948 pack .vpane.lower.diff.header.path -fill x
1949 set ctxm .vpane.lower.diff.header.ctxm
1950 menu $ctxm -tearoff 0
1951 $ctxm add command \
1952 -label {Copy} \
1953 -command {
1954 clipboard clear
1955 clipboard append \
1956 -format STRING \
1957 -type STRING \
1958 -- $current_diff_path
1960 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
1961 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
1963 # -- Diff Body
1965 frame .vpane.lower.diff.body
1966 set ui_diff .vpane.lower.diff.body.t
1967 text $ui_diff -background white -borderwidth 0 \
1968 -width 80 -height 15 -wrap none \
1969 -font font_diff \
1970 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1971 -yscrollcommand {.vpane.lower.diff.body.sby set} \
1972 -state disabled
1973 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1974 -command [list $ui_diff xview]
1975 scrollbar .vpane.lower.diff.body.sby -orient vertical \
1976 -command [list $ui_diff yview]
1977 pack .vpane.lower.diff.body.sbx -side bottom -fill x
1978 pack .vpane.lower.diff.body.sby -side right -fill y
1979 pack $ui_diff -side left -fill both -expand 1
1980 pack .vpane.lower.diff.header -side top -fill x
1981 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1983 $ui_diff tag conf d_cr -elide true
1984 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
1985 $ui_diff tag conf d_+ -foreground {#00a000}
1986 $ui_diff tag conf d_- -foreground red
1988 $ui_diff tag conf d_++ -foreground {#00a000}
1989 $ui_diff tag conf d_-- -foreground red
1990 $ui_diff tag conf d_+s \
1991 -foreground {#00a000} \
1992 -background {#e2effa}
1993 $ui_diff tag conf d_-s \
1994 -foreground red \
1995 -background {#e2effa}
1996 $ui_diff tag conf d_s+ \
1997 -foreground {#00a000} \
1998 -background ivory1
1999 $ui_diff tag conf d_s- \
2000 -foreground red \
2001 -background ivory1
2003 $ui_diff tag conf d<<<<<<< \
2004 -foreground orange \
2005 -font font_diffbold
2006 $ui_diff tag conf d======= \
2007 -foreground orange \
2008 -font font_diffbold
2009 $ui_diff tag conf d>>>>>>> \
2010 -foreground orange \
2011 -font font_diffbold
2013 $ui_diff tag raise sel
2015 # -- Diff Body Context Menu
2017 set ctxm .vpane.lower.diff.body.ctxm
2018 menu $ctxm -tearoff 0
2019 $ctxm add command \
2020 -label {Refresh} \
2021 -command reshow_diff
2022 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2023 $ctxm add command \
2024 -label {Copy} \
2025 -command {tk_textCopy $ui_diff}
2026 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2027 $ctxm add command \
2028 -label {Select All} \
2029 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2030 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2031 $ctxm add command \
2032 -label {Copy All} \
2033 -command {
2034 $ui_diff tag add sel 0.0 end
2035 tk_textCopy $ui_diff
2036 $ui_diff tag remove sel 0.0 end
2038 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2039 $ctxm add separator
2040 $ctxm add command \
2041 -label {Apply/Reverse Hunk} \
2042 -command {apply_hunk $cursorX $cursorY}
2043 set ui_diff_applyhunk [$ctxm index last]
2044 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2045 $ctxm add separator
2046 $ctxm add command \
2047 -label {Decrease Font Size} \
2048 -command {incr_font_size font_diff -1}
2049 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2050 $ctxm add command \
2051 -label {Increase Font Size} \
2052 -command {incr_font_size font_diff 1}
2053 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2054 $ctxm add separator
2055 $ctxm add command \
2056 -label {Show Less Context} \
2057 -command {if {$repo_config(gui.diffcontext) >= 1} {
2058 incr repo_config(gui.diffcontext) -1
2059 reshow_diff
2061 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2062 $ctxm add command \
2063 -label {Show More Context} \
2064 -command {if {$repo_config(gui.diffcontext) < 99} {
2065 incr repo_config(gui.diffcontext)
2066 reshow_diff
2068 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2069 $ctxm add separator
2070 $ctxm add command -label {Options...} \
2071 -command do_options
2072 bind_button3 $ui_diff "
2073 set cursorX %x
2074 set cursorY %y
2075 if {\$ui_index eq \$current_diff_side} {
2076 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
2077 } else {
2078 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
2080 tk_popup $ctxm %X %Y
2082 unset ui_diff_applyhunk
2084 # -- Status Bar
2086 label .status -textvariable ui_status_value \
2087 -anchor w \
2088 -justify left \
2089 -borderwidth 1 \
2090 -relief sunken
2091 pack .status -anchor w -side bottom -fill x
2093 # -- Load geometry
2095 catch {
2096 set gm $repo_config(gui.geometry)
2097 wm geometry . [lindex $gm 0]
2098 .vpane sash place 0 \
2099 [lindex [.vpane sash coord 0] 0] \
2100 [lindex $gm 1]
2101 .vpane.files sash place 0 \
2102 [lindex $gm 2] \
2103 [lindex [.vpane.files sash coord 0] 1]
2104 unset gm
2107 # -- Key Bindings
2109 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2110 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2111 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2112 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2113 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2114 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2115 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2116 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2117 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2118 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2119 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2121 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2122 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2123 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2124 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2125 bind $ui_diff <$M1B-Key-v> {break}
2126 bind $ui_diff <$M1B-Key-V> {break}
2127 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2128 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2129 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2130 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2131 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2132 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2133 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
2134 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
2135 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
2136 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
2137 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2138 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
2139 bind $ui_diff <Button-1> {focus %W}
2141 if {[is_enabled branch]} {
2142 bind . <$M1B-Key-n> do_create_branch
2143 bind . <$M1B-Key-N> do_create_branch
2146 bind all <Key-F5> do_rescan
2147 bind all <$M1B-Key-r> do_rescan
2148 bind all <$M1B-Key-R> do_rescan
2149 bind . <$M1B-Key-s> do_signoff
2150 bind . <$M1B-Key-S> do_signoff
2151 bind . <$M1B-Key-i> do_add_all
2152 bind . <$M1B-Key-I> do_add_all
2153 bind . <$M1B-Key-Return> do_commit
2154 foreach i [list $ui_index $ui_workdir] {
2155 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2156 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2157 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2159 unset i
2161 set file_lists($ui_index) [list]
2162 set file_lists($ui_workdir) [list]
2164 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2165 focus -force $ui_comm
2167 # -- Warn the user about environmental problems. Cygwin's Tcl
2168 # does *not* pass its env array onto any processes it spawns.
2169 # This means that git processes get none of our environment.
2171 if {[is_Cygwin]} {
2172 set ignored_env 0
2173 set suggest_user {}
2174 set msg "Possible environment issues exist.
2176 The following environment variables are probably
2177 going to be ignored by any Git subprocess run
2178 by [appname]:
2181 foreach name [array names env] {
2182 switch -regexp -- $name {
2183 {^GIT_INDEX_FILE$} -
2184 {^GIT_OBJECT_DIRECTORY$} -
2185 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2186 {^GIT_DIFF_OPTS$} -
2187 {^GIT_EXTERNAL_DIFF$} -
2188 {^GIT_PAGER$} -
2189 {^GIT_TRACE$} -
2190 {^GIT_CONFIG$} -
2191 {^GIT_CONFIG_LOCAL$} -
2192 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2193 append msg " - $name\n"
2194 incr ignored_env
2196 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2197 append msg " - $name\n"
2198 incr ignored_env
2199 set suggest_user $name
2203 if {$ignored_env > 0} {
2204 append msg "
2205 This is due to a known issue with the
2206 Tcl binary distributed by Cygwin."
2208 if {$suggest_user ne {}} {
2209 append msg "
2211 A good replacement for $suggest_user
2212 is placing values for the user.name and
2213 user.email settings into your personal
2214 ~/.gitconfig file.
2217 warn_popup $msg
2219 unset ignored_env msg suggest_user name
2222 # -- Only initialize complex UI if we are going to stay running.
2224 if {[is_enabled transport]} {
2225 load_all_remotes
2226 load_all_heads
2228 populate_branch_menu
2229 populate_fetch_menu
2230 populate_push_menu
2233 # -- Only suggest a gc run if we are going to stay running.
2235 if {[is_enabled multicommit]} {
2236 set object_limit 2000
2237 if {[is_Windows]} {set object_limit 200}
2238 regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
2239 if {$objects_current >= $object_limit} {
2240 if {[ask_popup \
2241 "This repository currently has $objects_current loose objects.
2243 To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2245 Compress the database now?"] eq yes} {
2246 do_gc
2249 unset object_limit _junk objects_current
2252 lock_index begin-read
2253 after 1 do_rescan