2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 ||
test "z$*" = z--version
; \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
11 set appvers
{@@GITGUI_VERSION@@
}
13 Copyright ©
2006, 2007 Shawn Pearce
, et. al.
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.
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.
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
}
29 ######################################################################
31 ## Tcl/Tk sanity check
33 if {[catch
{package require Tcl
8.4} err
]
34 ||
[catch
{package require Tk
8.4} err
]
40 -title "git-gui: fatal error" \
45 ######################################################################
47 ## enable verbose loading?
49 if {![catch
{set _verbose
$env(GITGUI_VERBOSE
)}]} {
51 rename auto_load real__auto_load
52 proc auto_load
{name args
} {
53 puts stderr
"auto_load $name"
54 return [uplevel
1 real__auto_load
$name $args]
56 rename
source real__source
58 puts stderr
"source $name"
59 uplevel
1 real__source
$name
63 ######################################################################
65 ## configure our library
67 set oguilib
{@@GITGUI_LIBDIR@@
}
68 set oguirel
{@@GITGUI_RELATIVE@@
}
69 if {$oguirel eq
{1}} {
70 set oguilib
[file dirname [file dirname [file normalize
$argv0]]]
71 set oguilib
[file join $oguilib share git-gui lib
]
72 } elseif
{[string match @@
* $oguirel]} {
73 set oguilib
[file join [file dirname [file normalize
$argv0]] lib
]
76 set idx
[file join $oguilib tclIndex
]
77 if {[catch
{set fd
[open
$idx r
]} err
]} {
82 -title "git-gui: fatal error" \
86 if {[gets
$fd] eq
{# Autogenerated by git-gui Makefile}} {
88 while {[gets
$fd n
] >= 0} {
89 if {$n ne
{} && ![string match
#* $n]} {
101 if {[lsearch
-exact $loaded $p] >= 0} continue
102 source [file join $oguilib $p]
107 set auto_path
[concat
[list
$oguilib] $auto_path]
109 unset -nocomplain oguirel idx fd
111 ######################################################################
115 set _appname
[lindex
[file split $argv0] end
]
131 return [eval [concat
[list
file join $_gitdir] $args]]
134 proc gitexec
{args
} {
136 if {$_gitexec eq
{}} {
137 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
138 error
"Git not installed?\n\n$err"
144 return [eval [concat
[list
file join $_gitexec] $args]]
153 global tcl_platform tk_library
154 if {[tk windowingsystem
] eq
{aqua
}} {
162 if {$tcl_platform(platform
) eq
{windows
}} {
169 global tcl_platform _iscygwin
170 if {$_iscygwin eq
{}} {
171 if {$tcl_platform(platform
) eq
{windows
}} {
172 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
184 proc is_enabled
{option
} {
185 global enabled_options
186 if {[catch
{set on
$enabled_options($option)}]} {return 0}
190 proc enable_option
{option
} {
191 global enabled_options
192 set enabled_options
($option) 1
195 proc disable_option
{option
} {
196 global enabled_options
197 set enabled_options
($option) 0
200 ######################################################################
204 proc is_many_config
{name
} {
205 switch
-glob -- $name {
214 proc is_config_true
{name
} {
216 if {[catch
{set v
$repo_config($name)}]} {
218 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
225 proc get_config
{name
} {
227 if {[catch
{set v
$repo_config($name)}]} {
234 proc load_config
{include_global
} {
235 global repo_config global_config default_config
237 array
unset global_config
238 if {$include_global} {
240 set fd_rc
[open
"| git config --global --list" r
]
241 while {[gets
$fd_rc line
] >= 0} {
242 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
243 if {[is_many_config
$name]} {
244 lappend global_config
($name) $value
246 set global_config
($name) $value
254 array
unset repo_config
256 set fd_rc
[open
"| git config --list" r
]
257 while {[gets
$fd_rc line
] >= 0} {
258 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
259 if {[is_many_config
$name]} {
260 lappend repo_config
($name) $value
262 set repo_config
($name) $value
269 foreach name
[array names default_config
] {
270 if {[catch
{set v
$global_config($name)}]} {
271 set global_config
($name) $default_config($name)
273 if {[catch
{set v
$repo_config($name)}]} {
274 set repo_config
($name) $default_config($name)
279 ######################################################################
284 return [eval exec git
$args]
287 proc current-branch
{} {
288 set fd
[open
[gitdir HEAD
] r
]
289 if {[gets
$fd ref
] < 1} {
294 set pfx
{ref
: refs
/heads
/}
295 set len
[string length
$pfx]
296 if {[string equal
-length $len $pfx $ref]} {
297 # We're on a branch. It might not exist. But
298 # HEAD looks good enough to be a branch.
300 return [string range
$ref $len end
]
302 # Assume this is a detached head.
308 auto_load tk_optionMenu
309 rename tk_optionMenu real__tkOptionMenu
310 proc tk_optionMenu
{w varName args
} {
311 set m
[eval real__tkOptionMenu
$w $varName $args]
312 $m configure
-font font_ui
313 $w configure
-font font_ui
317 ######################################################################
321 if {[catch
{set _git_version
[git
--version]} err
]} {
322 catch
{wm withdraw .
}
323 error_popup
"Cannot determine Git version:
327 [appname] requires Git 1.5.0 or later."
330 if {![regsub
{^git version
} $_git_version {} _git_version
]} {
331 catch
{wm withdraw .
}
332 error_popup
"Cannot parse Git version string:\n\n$_git_version"
335 regsub
{\.
[0-9]+\.g
[0-9a-f]+$
} $_git_version {} _git_version
336 regsub
{\.rc
[0-9]+$
} $_git_version {} _git_version
338 proc git-version
{args
} {
341 switch
[llength
$args] {
347 set op
[lindex
$args 0]
348 set vr
[lindex
$args 1]
349 set cm
[package vcompare
$_git_version $vr]
350 return [expr $cm $op 0]
354 set type [lindex
$args 0]
355 set name
[lindex
$args 1]
356 set parm
[lindex
$args 2]
357 set body
[lindex
$args 3]
359 if {($type ne
{proc
} && $type ne
{method
})} {
360 error
"Invalid arguments to git-version"
362 if {[llength
$body] < 2 ||
[lindex
$body end-1
] ne
{default
}} {
363 error
"Last arm of $type $name must be default"
366 foreach
{op vr cb
} [lrange
$body 0 end-2
] {
367 if {[git-version
$op $vr]} {
368 return [uplevel
[list
$type $name $parm $cb]]
372 return [uplevel
[list
$type $name $parm [lindex
$body end
]]]
376 error
"git-version >= x"
382 if {[git-version
< 1.5]} {
383 catch
{wm withdraw .
}
384 error_popup
"[appname] requires Git 1.5.0 or later.
386 You are using [git-version]:
392 ######################################################################
397 set _gitdir
$env(GIT_DIR
)
401 set _gitdir
[git rev-parse
--git-dir]
402 set _prefix
[git rev-parse
--show-prefix]
404 catch
{wm withdraw .
}
405 error_popup
"Cannot find the git directory:\n\n$err"
408 if {![file isdirectory
$_gitdir] && [is_Cygwin
]} {
409 catch
{set _gitdir
[exec cygpath
--unix $_gitdir]}
411 if {![file isdirectory
$_gitdir]} {
412 catch
{wm withdraw .
}
413 error_popup
"Git directory not found:\n\n$_gitdir"
416 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
417 catch
{wm withdraw .
}
418 error_popup
"Cannot use funny .git directory:\n\n$_gitdir"
421 if {[catch
{cd [file dirname $_gitdir]} err
]} {
422 catch
{wm withdraw .
}
423 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
426 set _reponame
[lindex
[file split \
427 [file normalize
[file dirname $_gitdir]]] \
430 ######################################################################
434 set current_diff_path
{}
435 set current_diff_side
{}
436 set diff_actions
[list
]
437 set ui_status_value
{Initializing...
}
441 set MERGE_HEAD
[list
]
444 set current_branch
{}
445 set current_diff_path
{}
446 set selected_commit_type new
448 ######################################################################
456 set disable_on_lock
[list
]
457 set index_lock_type none
459 proc lock_index
{type} {
460 global index_lock_type disable_on_lock
462 if {$index_lock_type eq
{none
}} {
463 set index_lock_type
$type
464 foreach w
$disable_on_lock {
465 uplevel
#0 $w disabled
468 } elseif
{$index_lock_type eq
"begin-$type"} {
469 set index_lock_type
$type
475 proc unlock_index
{} {
476 global index_lock_type disable_on_lock
478 set index_lock_type none
479 foreach w
$disable_on_lock {
484 ######################################################################
488 proc repository_state
{ctvar hdvar mhvar
} {
489 global current_branch
490 upvar
$ctvar ct
$hdvar hd
$mhvar mh
494 set current_branch
[current-branch
]
495 if {[catch
{set hd
[git rev-parse
--verify HEAD
]}]} {
501 set merge_head
[gitdir MERGE_HEAD
]
502 if {[file exists
$merge_head]} {
504 set fd_mh
[open
$merge_head r
]
505 while {[gets
$fd_mh line
] >= 0} {
516 global PARENT empty_tree
518 set p
[lindex
$PARENT 0]
522 if {$empty_tree eq
{}} {
523 set empty_tree
[git mktree
<< {}]
528 proc rescan
{after
{honor_trustmtime
1}} {
529 global HEAD PARENT MERGE_HEAD commit_type
530 global ui_index ui_workdir ui_status_value ui_comm
531 global rescan_active file_states
534 if {$rescan_active > 0 ||
![lock_index
read]} return
536 repository_state newType newHEAD newMERGE_HEAD
537 if {[string match amend
* $commit_type]
538 && $newType eq
{normal
}
539 && $newHEAD eq
$HEAD} {
543 set MERGE_HEAD
$newMERGE_HEAD
544 set commit_type
$newType
547 array
unset file_states
549 if {![$ui_comm edit modified
]
550 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
551 if {[string match amend
* $commit_type]} {
552 } elseif
{[load_message GITGUI_MSG
]} {
553 } elseif
{[load_message MERGE_MSG
]} {
554 } elseif
{[load_message SQUASH_MSG
]} {
557 $ui_comm edit modified false
560 if {[is_enabled branch
]} {
565 if {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
566 rescan_stage2
{} $after
569 set ui_status_value
{Refreshing
file status...
}
570 set cmd
[list git update-index
]
572 lappend cmd
--unmerged
573 lappend cmd
--ignore-missing
574 lappend cmd
--refresh
575 set fd_rf
[open
"| $cmd" r
]
576 fconfigure
$fd_rf -blocking 0 -translation binary
577 fileevent
$fd_rf readable \
578 [list rescan_stage2
$fd_rf $after]
582 proc rescan_stage2
{fd after
} {
583 global ui_status_value
584 global rescan_active buf_rdi buf_rdf buf_rlo
588 if {![eof
$fd]} return
592 set ls_others
[list | git ls-files
--others -z \
593 --exclude-per-directory=.gitignore
]
594 set info_exclude
[gitdir info exclude
]
595 if {[file readable
$info_exclude]} {
596 lappend ls_others
"--exclude-from=$info_exclude"
604 set ui_status_value
{Scanning
for modified files ...
}
605 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
606 set fd_df
[open
"| git diff-files -z" r
]
607 set fd_lo
[open
$ls_others r
]
609 fconfigure
$fd_di -blocking 0 -translation binary
-encoding binary
610 fconfigure
$fd_df -blocking 0 -translation binary
-encoding binary
611 fconfigure
$fd_lo -blocking 0 -translation binary
-encoding binary
612 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
613 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
614 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
617 proc load_message
{file} {
621 if {[file isfile
$f]} {
622 if {[catch
{set fd
[open
$f r
]}]} {
625 set content
[string trim
[read $fd]]
627 regsub
-all -line {[ \r\t]+$
} $content {} content
628 $ui_comm delete
0.0 end
629 $ui_comm insert end
$content
635 proc read_diff_index
{fd after
} {
638 append buf_rdi
[read $fd]
640 set n
[string length
$buf_rdi]
642 set z1
[string first
"\0" $buf_rdi $c]
645 set z2
[string first
"\0" $buf_rdi $z1]
649 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
650 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
652 [encoding convertfrom
$p] \
654 [list
[lindex
$i 0] [lindex
$i 2]] \
660 set buf_rdi
[string range
$buf_rdi $c end
]
665 rescan_done
$fd buf_rdi
$after
668 proc read_diff_files
{fd after
} {
671 append buf_rdf
[read $fd]
673 set n
[string length
$buf_rdf]
675 set z1
[string first
"\0" $buf_rdf $c]
678 set z2
[string first
"\0" $buf_rdf $z1]
682 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
683 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
685 [encoding convertfrom
$p] \
688 [list
[lindex
$i 0] [lindex
$i 2]]
693 set buf_rdf
[string range
$buf_rdf $c end
]
698 rescan_done
$fd buf_rdf
$after
701 proc read_ls_others
{fd after
} {
704 append buf_rlo
[read $fd]
705 set pck
[split $buf_rlo "\0"]
706 set buf_rlo
[lindex
$pck end
]
707 foreach p
[lrange
$pck 0 end-1
] {
708 merge_state
[encoding convertfrom
$p] ?O
710 rescan_done
$fd buf_rlo
$after
713 proc rescan_done
{fd buf after
} {
714 global rescan_active current_diff_path
715 global file_states repo_config
718 if {![eof
$fd]} return
721 if {[incr rescan_active
-1] > 0} return
726 if {$current_diff_path ne
{}} reshow_diff
730 proc prune_selection
{} {
731 global file_states selected_paths
733 foreach path
[array names selected_paths
] {
734 if {[catch
{set still_here
$file_states($path)}]} {
735 unset selected_paths
($path)
740 ######################################################################
744 proc mapicon
{w state path
} {
747 if {[catch
{set r
$all_icons($state$w)}]} {
748 puts
"error: no icon for $w state={$state} $path"
754 proc mapdesc
{state path
} {
757 if {[catch
{set r
$all_descs($state)}]} {
758 puts
"error: no desc for state={$state} $path"
764 proc escape_path
{path
} {
765 regsub
-all {\\} $path "\\\\" path
766 regsub
-all "\n" $path "\\n" path
770 proc short_path
{path
} {
771 return [escape_path
[lindex
[file split $path] end
]]
775 set null_sha1
[string repeat
0 40]
777 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
778 global file_states next_icon_id null_sha1
780 set s0
[string index
$new_state 0]
781 set s1
[string index
$new_state 1]
783 if {[catch
{set info
$file_states($path)}]} {
785 set icon n
[incr next_icon_id
]
787 set state
[lindex
$info 0]
788 set icon
[lindex
$info 1]
789 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
790 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
793 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
794 elseif
{$s0 eq
{_
}} {set s0 _
}
796 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
797 elseif
{$s1 eq
{_
}} {set s1 _
}
799 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
800 set head_info
[list
0 $null_sha1]
801 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
802 && $head_info eq
{}} {
803 set head_info
$index_info
806 set file_states
($path) [list
$s0$s1 $icon \
807 $head_info $index_info \
812 proc display_file_helper
{w path icon_name old_m new_m
} {
816 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
818 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
820 $w conf
-state normal
821 $w delete
$lno.0 [expr {$lno + 1}].0
822 $w conf
-state disabled
824 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
825 lappend file_lists
($w) $path
826 set file_lists
($w) [lsort
-unique $file_lists($w)]
827 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
829 $w conf
-state normal
830 $w image create
$lno.0 \
831 -align center
-padx 5 -pady 1 \
833 -image [mapicon
$w $new_m $path]
834 $w insert
$lno.1 "[escape_path $path]\n"
835 $w conf
-state disabled
836 } elseif
{$old_m ne
$new_m} {
837 $w conf
-state normal
838 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
839 $w conf
-state disabled
843 proc display_file
{path state
} {
844 global file_states selected_paths
845 global ui_index ui_workdir
847 set old_m
[merge_state
$path $state]
848 set s
$file_states($path)
849 set new_m
[lindex
$s 0]
850 set icon_name
[lindex
$s 1]
852 set o
[string index
$old_m 0]
853 set n
[string index
$new_m 0]
860 display_file_helper
$ui_index $path $icon_name $o $n
862 if {[string index
$old_m 0] eq
{U
}} {
865 set o
[string index
$old_m 1]
867 if {[string index
$new_m 0] eq
{U
}} {
870 set n
[string index
$new_m 1]
872 display_file_helper
$ui_workdir $path $icon_name $o $n
874 if {$new_m eq
{__
}} {
875 unset file_states
($path)
876 catch
{unset selected_paths
($path)}
880 proc display_all_files_helper
{w path icon_name m
} {
883 lappend file_lists
($w) $path
884 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
885 $w image create end \
886 -align center
-padx 5 -pady 1 \
888 -image [mapicon
$w $m $path]
889 $w insert end
"[escape_path $path]\n"
892 proc display_all_files
{} {
893 global ui_index ui_workdir
894 global file_states file_lists
897 $ui_index conf
-state normal
898 $ui_workdir conf
-state normal
900 $ui_index delete
0.0 end
901 $ui_workdir delete
0.0 end
904 set file_lists
($ui_index) [list
]
905 set file_lists
($ui_workdir) [list
]
907 foreach path
[lsort
[array names file_states
]] {
908 set s
$file_states($path)
910 set icon_name
[lindex
$s 1]
912 set s
[string index
$m 0]
913 if {$s ne
{U
} && $s ne
{_
}} {
914 display_all_files_helper
$ui_index $path \
918 if {[string index
$m 0] eq
{U
}} {
921 set s
[string index
$m 1]
924 display_all_files_helper
$ui_workdir $path \
929 $ui_index conf
-state disabled
930 $ui_workdir conf
-state disabled
933 ######################################################################
938 #define mask_width 14
939 #define mask_height 15
940 static unsigned char mask_bits
[] = {
941 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
942 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
943 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
946 image create bitmap file_plain
-background white
-foreground black
-data {
947 #define plain_width 14
948 #define plain_height 15
949 static unsigned char plain_bits
[] = {
950 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
951 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
952 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
953 } -maskdata $filemask
955 image create bitmap file_mod
-background white
-foreground blue
-data {
957 #define mod_height 15
958 static unsigned char mod_bits
[] = {
959 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
960 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
961 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
962 } -maskdata $filemask
964 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
965 #define file_fulltick_width 14
966 #define file_fulltick_height 15
967 static unsigned char file_fulltick_bits
[] = {
968 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
969 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
970 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
971 } -maskdata $filemask
973 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
974 #define parttick_width 14
975 #define parttick_height 15
976 static unsigned char parttick_bits
[] = {
977 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
978 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
979 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
980 } -maskdata $filemask
982 image create bitmap file_question
-background white
-foreground black
-data {
983 #define file_question_width 14
984 #define file_question_height 15
985 static unsigned char file_question_bits
[] = {
986 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
987 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
988 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
989 } -maskdata $filemask
991 image create bitmap file_removed
-background white
-foreground red
-data {
992 #define file_removed_width 14
993 #define file_removed_height 15
994 static unsigned char file_removed_bits
[] = {
995 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
996 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
997 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
998 } -maskdata $filemask
1000 image create bitmap file_merge
-background white
-foreground blue
-data {
1001 #define file_merge_width 14
1002 #define file_merge_height 15
1003 static unsigned char file_merge_bits
[] = {
1004 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1005 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1006 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1007 } -maskdata $filemask
1010 #define file_width 18
1011 #define file_height 18
1012 static unsigned char file_bits
[] = {
1013 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
1014 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
1015 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
1016 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
1017 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
1019 image create bitmap file_dir
-background white
-foreground blue \
1020 -data $file_dir_data -maskdata $file_dir_data
1023 set file_uplevel_data
{
1025 #define up_height 15
1026 static unsigned char up_bits
[] = {
1027 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
1028 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
1029 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
1031 image create bitmap file_uplevel
-background white
-foreground red \
1032 -data $file_uplevel_data -maskdata $file_uplevel_data
1033 unset file_uplevel_data
1035 set ui_index .vpane.files.index.list
1036 set ui_workdir .vpane.files.workdir.list
1038 set all_icons
(_
$ui_index) file_plain
1039 set all_icons
(A
$ui_index) file_fulltick
1040 set all_icons
(M
$ui_index) file_fulltick
1041 set all_icons
(D
$ui_index) file_removed
1042 set all_icons
(U
$ui_index) file_merge
1044 set all_icons
(_
$ui_workdir) file_plain
1045 set all_icons
(M
$ui_workdir) file_mod
1046 set all_icons
(D
$ui_workdir) file_question
1047 set all_icons
(U
$ui_workdir) file_merge
1048 set all_icons
(O
$ui_workdir) file_plain
1050 set max_status_desc
0
1054 {_M
"Modified, not staged"}
1055 {M_
"Staged for commit"}
1056 {MM
"Portions staged for commit"}
1057 {MD
"Staged for commit, missing"}
1059 {_O
"Untracked, not staged"}
1060 {A_
"Staged for commit"}
1061 {AM
"Portions staged for commit"}
1062 {AD
"Staged for commit, missing"}
1065 {D_
"Staged for removal"}
1066 {DO
"Staged for removal, still present"}
1068 {U_
"Requires merge resolution"}
1069 {UU
"Requires merge resolution"}
1070 {UM
"Requires merge resolution"}
1071 {UD
"Requires merge resolution"}
1073 if {$max_status_desc < [string length
[lindex
$i 1]]} {
1074 set max_status_desc
[string length
[lindex
$i 1]]
1076 set all_descs
([lindex
$i 0]) [lindex
$i 1]
1080 ######################################################################
1084 proc bind_button3
{w cmd
} {
1085 bind $w <Any-Button-3
> $cmd
1087 bind $w <Control-Button-1
> $cmd
1091 proc scrollbar2many
{list mode args
} {
1092 foreach w
$list {eval $w $mode $args}
1095 proc many2scrollbar
{list mode sb top bottom
} {
1096 $sb set $top $bottom
1097 foreach w
$list {$w $mode moveto
$top}
1100 proc incr_font_size
{font
{amt
1}} {
1101 set sz
[font configure
$font -size]
1103 font configure
$font -size $sz
1104 font configure
${font}bold
-size $sz
1105 font configure
${font}italic
-size $sz
1108 ######################################################################
1112 set starting_gitk_msg
{Starting gitk... please
wait...
}
1114 proc do_gitk
{revs
} {
1115 global env ui_status_value starting_gitk_msg
1117 # -- Always start gitk through whatever we were loaded with. This
1118 # lets us bypass using shell process on Windows systems.
1120 set cmd
[list
[info nameofexecutable
]]
1121 set exe
[gitexec gitk
]
1128 if {! [file exists
$exe]} {
1129 error_popup
"Unable to start gitk:\n\n$exe does not exist"
1132 set ui_status_value
$starting_gitk_msg
1134 if {$ui_status_value eq
$starting_gitk_msg} {
1135 set ui_status_value
{Ready.
}
1144 global ui_comm is_quitting repo_config commit_type
1146 if {$is_quitting} return
1149 if {[winfo exists
$ui_comm]} {
1150 # -- Stash our current commit buffer.
1152 set save
[gitdir GITGUI_MSG
]
1153 set msg
[string trim
[$ui_comm get
0.0 end
]]
1154 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1155 if {(![string match amend
* $commit_type]
1156 ||
[$ui_comm edit modified
])
1159 set fd
[open
$save w
]
1160 puts
-nonewline $fd $msg
1164 catch
{file delete
$save}
1167 # -- Stash our current window geometry into this repository.
1169 set cfg_geometry
[list
]
1170 lappend cfg_geometry
[wm geometry .
]
1171 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1172 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1173 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1176 if {$cfg_geometry ne
$rc_geometry} {
1177 catch
{git config gui.geometry
$cfg_geometry}
1185 rescan
{set ui_status_value
{Ready.
}}
1192 proc toggle_or_diff
{w x y
} {
1193 global file_states file_lists current_diff_path ui_index ui_workdir
1194 global last_clicked selected_paths
1196 set pos
[split [$w index @
$x,$y] .
]
1197 set lno
[lindex
$pos 0]
1198 set col [lindex
$pos 1]
1199 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1205 set last_clicked
[list
$w $lno]
1206 array
unset selected_paths
1207 $ui_index tag remove in_sel
0.0 end
1208 $ui_workdir tag remove in_sel
0.0 end
1211 if {$current_diff_path eq
$path} {
1212 set after
{reshow_diff
;}
1216 if {$w eq
$ui_index} {
1218 "Unstaging [short_path $path] from commit" \
1220 [concat
$after {set ui_status_value
{Ready.
}}]
1221 } elseif
{$w eq
$ui_workdir} {
1223 "Adding [short_path $path]" \
1225 [concat
$after {set ui_status_value
{Ready.
}}]
1228 show_diff
$path $w $lno
1232 proc add_one_to_selection
{w x y
} {
1233 global file_lists last_clicked selected_paths
1235 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1236 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1242 if {$last_clicked ne
{}
1243 && [lindex
$last_clicked 0] ne
$w} {
1244 array
unset selected_paths
1245 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
1248 set last_clicked
[list
$w $lno]
1249 if {[catch
{set in_sel
$selected_paths($path)}]} {
1253 unset selected_paths
($path)
1254 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
1256 set selected_paths
($path) 1
1257 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1261 proc add_range_to_selection
{w x y
} {
1262 global file_lists last_clicked selected_paths
1264 if {[lindex
$last_clicked 0] ne
$w} {
1265 toggle_or_diff
$w $x $y
1269 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1270 set lc
[lindex
$last_clicked 1]
1279 foreach path
[lrange
$file_lists($w) \
1280 [expr {$begin - 1}] \
1281 [expr {$end - 1}]] {
1282 set selected_paths
($path) 1
1284 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
1287 ######################################################################
1291 set cursor_ptr arrow
1292 font create font_diff
-family Courier
-size 10
1296 eval font configure font_ui
[font actual
[.dummy cget
-font]]
1300 font create font_uiitalic
1301 font create font_uibold
1302 font create font_diffbold
1303 font create font_diffitalic
1305 foreach class
{Button Checkbutton Entry Label
1306 Labelframe Listbox Menu Message
1307 Radiobutton Spinbox Text
} {
1308 option add
*$class.font font_ui
1312 if {[is_Windows
] ||
[is_MacOSX
]} {
1313 option add
*Menu.tearOff
0
1324 proc apply_config
{} {
1325 global repo_config font_descs
1327 foreach option
$font_descs {
1328 set name
[lindex
$option 0]
1329 set font
[lindex
$option 1]
1331 foreach
{cn cv
} $repo_config(gui.
$name) {
1332 font configure
$font $cn $cv
1335 error_popup
"Invalid font specified in gui.$name:\n\n$err"
1337 foreach
{cn cv
} [font configure
$font] {
1338 font configure
${font}bold
$cn $cv
1339 font configure
${font}italic
$cn $cv
1341 font configure
${font}bold
-weight bold
1342 font configure
${font}italic
-slant italic
1346 set default_config
(merge.diffstat
) true
1347 set default_config
(merge.summary
) false
1348 set default_config
(merge.verbosity
) 2
1349 set default_config
(user.name
) {}
1350 set default_config
(user.email
) {}
1352 set default_config
(gui.matchtrackingbranch
) false
1353 set default_config
(gui.pruneduringfetch
) false
1354 set default_config
(gui.trustmtime
) false
1355 set default_config
(gui.diffcontext
) 5
1356 set default_config
(gui.newbranchtemplate
) {}
1357 set default_config
(gui.fontui
) [font configure font_ui
]
1358 set default_config
(gui.fontdiff
) [font configure font_diff
]
1360 {fontui font_ui
{Main Font
}}
1361 {fontdiff font_diff
{Diff
/Console Font
}}
1366 ######################################################################
1368 ## feature option selection
1370 if {[regexp
{^git-
(.
+)$
} [appname
] _junk subcommand
]} {
1375 if {$subcommand eq
{gui.sh
}} {
1378 if {$subcommand eq
{gui
} && [llength
$argv] > 0} {
1379 set subcommand
[lindex
$argv 0]
1380 set argv
[lrange
$argv 1 end
]
1383 enable_option multicommit
1384 enable_option branch
1385 enable_option transport
1387 switch
-- $subcommand {
1390 disable_option multicommit
1391 disable_option branch
1392 disable_option transport
1395 enable_option singlecommit
1397 disable_option multicommit
1398 disable_option branch
1399 disable_option transport
1403 ######################################################################
1411 menu .mbar
-tearoff 0
1412 .mbar add cascade
-label Repository
-menu .mbar.repository
1413 .mbar add cascade
-label Edit
-menu .mbar.edit
1414 if {[is_enabled branch
]} {
1415 .mbar add cascade
-label Branch
-menu .mbar.branch
1417 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1418 .mbar add cascade
-label Commit
-menu .mbar.commit
1420 if {[is_enabled transport
]} {
1421 .mbar add cascade
-label Merge
-menu .mbar.merge
1422 .mbar add cascade
-label Fetch
-menu .mbar.fetch
1423 .mbar add cascade
-label Push
-menu .mbar.push
1425 . configure
-menu .mbar
1427 # -- Repository Menu
1429 menu .mbar.repository
1431 .mbar.repository add
command \
1432 -label {Browse Current Branch
} \
1433 -command {browser
::new
$current_branch}
1434 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1435 .mbar.repository add separator
1437 .mbar.repository add
command \
1438 -label {Visualize Current Branch
} \
1439 -command {do_gitk
$current_branch}
1440 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1441 .mbar.repository add
command \
1442 -label {Visualize All Branches
} \
1443 -command {do_gitk
--all}
1444 .mbar.repository add separator
1446 if {[is_enabled multicommit
]} {
1447 .mbar.repository add
command -label {Database Statistics
} \
1450 .mbar.repository add
command -label {Compress Database
} \
1453 .mbar.repository add
command -label {Verify Database
} \
1454 -command do_fsck_objects
1456 .mbar.repository add separator
1459 .mbar.repository add
command \
1460 -label {Create Desktop Icon
} \
1461 -command do_cygwin_shortcut
1462 } elseif
{[is_Windows
]} {
1463 .mbar.repository add
command \
1464 -label {Create Desktop Icon
} \
1465 -command do_windows_shortcut
1466 } elseif
{[is_MacOSX
]} {
1467 .mbar.repository add
command \
1468 -label {Create Desktop Icon
} \
1469 -command do_macosx_app
1473 .mbar.repository add
command -label Quit \
1480 .mbar.edit add
command -label Undo \
1481 -command {catch
{[focus
] edit undo
}} \
1483 .mbar.edit add
command -label Redo \
1484 -command {catch
{[focus
] edit redo
}} \
1486 .mbar.edit add separator
1487 .mbar.edit add
command -label Cut \
1488 -command {catch
{tk_textCut
[focus
]}} \
1490 .mbar.edit add
command -label Copy \
1491 -command {catch
{tk_textCopy
[focus
]}} \
1493 .mbar.edit add
command -label Paste \
1494 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
1496 .mbar.edit add
command -label Delete \
1497 -command {catch
{[focus
] delete sel.first sel.last
}} \
1499 .mbar.edit add separator
1500 .mbar.edit add
command -label {Select All
} \
1501 -command {catch
{[focus
] tag add sel
0.0 end
}} \
1506 if {[is_enabled branch
]} {
1509 .mbar.branch add
command -label {Create...
} \
1510 -command branch_create
::dialog \
1512 lappend disable_on_lock
[list .mbar.branch entryconf \
1513 [.mbar.branch index last
] -state]
1515 .mbar.branch add
command -label {Rename...
} \
1516 -command branch_rename
::dialog
1517 lappend disable_on_lock
[list .mbar.branch entryconf \
1518 [.mbar.branch index last
] -state]
1520 .mbar.branch add
command -label {Delete...
} \
1521 -command branch_delete
::dialog
1522 lappend disable_on_lock
[list .mbar.branch entryconf \
1523 [.mbar.branch index last
] -state]
1525 .mbar.branch add
command -label {Reset...
} \
1526 -command merge
::reset_hard
1527 lappend disable_on_lock
[list .mbar.branch entryconf \
1528 [.mbar.branch index last
] -state]
1533 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1536 .mbar.commit add radiobutton \
1537 -label {New Commit
} \
1538 -command do_select_commit_type \
1539 -variable selected_commit_type \
1541 lappend disable_on_lock \
1542 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1544 .mbar.commit add radiobutton \
1545 -label {Amend Last Commit
} \
1546 -command do_select_commit_type \
1547 -variable selected_commit_type \
1549 lappend disable_on_lock \
1550 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1552 .mbar.commit add separator
1554 .mbar.commit add
command -label Rescan \
1555 -command do_rescan \
1557 lappend disable_on_lock \
1558 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1560 .mbar.commit add
command -label {Add To Commit
} \
1561 -command do_add_selection
1562 lappend disable_on_lock \
1563 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1565 .mbar.commit add
command -label {Add Existing To Commit
} \
1566 -command do_add_all \
1568 lappend disable_on_lock \
1569 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1571 .mbar.commit add
command -label {Unstage From Commit
} \
1572 -command do_unstage_selection
1573 lappend disable_on_lock \
1574 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1576 .mbar.commit add
command -label {Revert Changes
} \
1577 -command do_revert_selection
1578 lappend disable_on_lock \
1579 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1581 .mbar.commit add separator
1583 .mbar.commit add
command -label {Sign Off
} \
1584 -command do_signoff \
1587 .mbar.commit add
command -label Commit \
1588 -command do_commit \
1589 -accelerator $M1T-Return
1590 lappend disable_on_lock \
1591 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1596 if {[is_enabled branch
]} {
1598 .mbar.merge add
command -label {Local Merge...
} \
1599 -command merge
::dialog
1600 lappend disable_on_lock \
1601 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1602 .mbar.merge add
command -label {Abort Merge...
} \
1603 -command merge
::reset_hard
1604 lappend disable_on_lock \
1605 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1611 if {[is_enabled transport
]} {
1615 .mbar.push add
command -label {Push...
} \
1616 -command do_push_anywhere \
1618 .mbar.push add
command -label {Delete...
} \
1619 -command remote_branch_delete
::dialog
1623 # -- Apple Menu (Mac OS X only)
1625 .mbar add cascade
-label Apple
-menu .mbar.apple
1628 .mbar.apple add
command -label "About [appname]" \
1630 .mbar.apple add
command -label "Options..." \
1635 .mbar.edit add separator
1636 .mbar.edit add
command -label {Options...
} \
1641 if {[is_Cygwin
] && [file exists
/usr
/local
/miga
/lib
/gui-miga
]} {
1643 global ui_status_value
1644 if {![lock_index update
]} return
1645 set cmd
[list sh
--login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
1646 set miga_fd
[open
"|$cmd" r
]
1647 fconfigure
$miga_fd -blocking 0
1648 fileevent
$miga_fd readable
[list miga_done
$miga_fd]
1649 set ui_status_value
{Running miga...
}
1651 proc miga_done
{fd
} {
1656 rescan
[list
set ui_status_value
{Ready.
}]
1659 .mbar add cascade
-label Tools
-menu .mbar.tools
1661 .mbar.tools add
command -label "Migrate" \
1663 lappend disable_on_lock \
1664 [list .mbar.tools entryconf
[.mbar.tools index last
] -state]
1670 .mbar add cascade
-label Help
-menu .mbar.
help
1674 .mbar.
help add
command -label "About [appname]" \
1679 catch
{set browser
$repo_config(instaweb.browser
)}
1680 set doc_path
[file dirname [gitexec
]]
1681 set doc_path
[file join $doc_path Documentation index.html
]
1684 set doc_path
[exec cygpath
--mixed $doc_path]
1687 if {$browser eq
{}} {
1690 } elseif
{[is_Cygwin
]} {
1691 set program_files
[file dirname [exec cygpath
--windir]]
1692 set program_files
[file join $program_files {Program Files
}]
1693 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
1694 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
1695 if {[file exists
$firefox]} {
1696 set browser
$firefox
1697 } elseif
{[file exists
$ie]} {
1700 unset program_files firefox ie
1704 if {[file isfile
$doc_path]} {
1705 set doc_url
"file:$doc_path"
1707 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
1710 if {$browser ne
{}} {
1711 .mbar.
help add
command -label {Online Documentation
} \
1712 -command [list
exec $browser $doc_url &]
1714 unset browser doc_path doc_url
1716 # -- Standard bindings
1718 wm protocol . WM_DELETE_WINDOW do_quit
1719 bind all
<$M1B-Key-q> do_quit
1720 bind all
<$M1B-Key-Q> do_quit
1721 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
1722 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
1724 set subcommand_args
{}
1726 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
1730 # -- Not a normal commit type invocation? Do that instead!
1732 switch
-- $subcommand {
1734 set subcommand_args
{rev?
}
1735 switch
[llength
$argv] {
1736 0 { set current_branch
[current-branch
] }
1737 1 { set current_branch
[lindex
$argv 0] }
1740 browser
::new
$current_branch
1744 set subcommand_args
{rev? path?
}
1749 if {$is_path ||
[file exists
$_prefix$a]} {
1750 if {$path ne
{}} usage
1753 } elseif
{$a eq
{--}} {
1755 if {$head ne
{}} usage
1760 } elseif
{$head eq
{}} {
1761 if {$head ne
{}} usage
1770 set current_branch
[current-branch
]
1772 set current_branch
$head
1775 if {$path eq
{}} usage
1776 blame
::new
$head $path
1781 if {[llength
$argv] != 0} {
1782 puts
-nonewline stderr
"usage: $argv0"
1783 if {$subcommand ne
{gui
} && [appname
] ne
"git-$subcommand"} {
1784 puts
-nonewline stderr
" $subcommand"
1789 # fall through to setup UI for commits
1792 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
1803 -text {Current Branch
:} \
1807 -textvariable current_branch \
1810 pack .branch.l1
-side left
1811 pack .branch.cb
-side left
-fill x
1812 pack .branch
-side top
-fill x
1814 # -- Main Window Layout
1816 panedwindow .vpane
-orient vertical
1817 panedwindow .vpane.files
-orient horizontal
1818 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
1819 pack .vpane
-anchor n
-side top
-fill both
-expand 1
1821 # -- Index File List
1823 frame .vpane.files.index
-height 100 -width 200
1824 label .vpane.files.index.title
-text {Staged Changes
(Will Be Committed
)} \
1825 -background lightgreen
1826 text
$ui_index -background white
-borderwidth 0 \
1827 -width 20 -height 10 \
1829 -cursor $cursor_ptr \
1830 -xscrollcommand {.vpane.files.index.sx
set} \
1831 -yscrollcommand {.vpane.files.index.sy
set} \
1833 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
1834 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
1835 pack .vpane.files.index.title
-side top
-fill x
1836 pack .vpane.files.index.sx
-side bottom
-fill x
1837 pack .vpane.files.index.sy
-side right
-fill y
1838 pack
$ui_index -side left
-fill both
-expand 1
1839 .vpane.files add .vpane.files.index
-sticky nsew
1841 # -- Working Directory File List
1843 frame .vpane.files.workdir
-height 100 -width 200
1844 label .vpane.files.workdir.title
-text {Unstaged Changes
(Will Not Be Committed
)} \
1845 -background lightsalmon
1846 text
$ui_workdir -background white
-borderwidth 0 \
1847 -width 20 -height 10 \
1849 -cursor $cursor_ptr \
1850 -xscrollcommand {.vpane.files.workdir.sx
set} \
1851 -yscrollcommand {.vpane.files.workdir.sy
set} \
1853 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
1854 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
1855 pack .vpane.files.workdir.title
-side top
-fill x
1856 pack .vpane.files.workdir.sx
-side bottom
-fill x
1857 pack .vpane.files.workdir.sy
-side right
-fill y
1858 pack
$ui_workdir -side left
-fill both
-expand 1
1859 .vpane.files add .vpane.files.workdir
-sticky nsew
1861 foreach i
[list
$ui_index $ui_workdir] {
1862 $i tag conf in_diff
-background lightgray
1863 $i tag conf in_sel
-background lightgray
1867 # -- Diff and Commit Area
1869 frame .vpane.lower
-height 300 -width 400
1870 frame .vpane.lower.commarea
1871 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
1872 pack .vpane.lower.commarea
-side top
-fill x
1873 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
1874 .vpane add .vpane.lower
-sticky nsew
1876 # -- Commit Area Buttons
1878 frame .vpane.lower.commarea.buttons
1879 label .vpane.lower.commarea.buttons.l
-text {} \
1882 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
1883 pack .vpane.lower.commarea.buttons
-side left
-fill y
1885 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
1887 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
1888 lappend disable_on_lock \
1889 {.vpane.lower.commarea.buttons.rescan conf
-state}
1891 button .vpane.lower.commarea.buttons.incall
-text {Add Existing
} \
1893 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
1894 lappend disable_on_lock \
1895 {.vpane.lower.commarea.buttons.incall conf
-state}
1897 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
1899 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
1901 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
1903 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
1904 lappend disable_on_lock \
1905 {.vpane.lower.commarea.buttons.commit conf
-state}
1907 button .vpane.lower.commarea.buttons.push
-text {Push
} \
1908 -command do_push_anywhere
1909 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
1911 # -- Commit Message Buffer
1913 frame .vpane.lower.commarea.buffer
1914 frame .vpane.lower.commarea.buffer.header
1915 set ui_comm .vpane.lower.commarea.buffer.t
1916 set ui_coml .vpane.lower.commarea.buffer.header.l
1917 radiobutton .vpane.lower.commarea.buffer.header.new \
1918 -text {New Commit
} \
1919 -command do_select_commit_type \
1920 -variable selected_commit_type \
1922 lappend disable_on_lock \
1923 [list .vpane.lower.commarea.buffer.header.new conf
-state]
1924 radiobutton .vpane.lower.commarea.buffer.header.amend \
1925 -text {Amend Last Commit
} \
1926 -command do_select_commit_type \
1927 -variable selected_commit_type \
1929 lappend disable_on_lock \
1930 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
1934 proc trace_commit_type
{varname args
} {
1935 global ui_coml commit_type
1936 switch
-glob -- $commit_type {
1937 initial
{set txt
{Initial Commit Message
:}}
1938 amend
{set txt
{Amended Commit Message
:}}
1939 amend-initial
{set txt
{Amended Initial Commit Message
:}}
1940 amend-merge
{set txt
{Amended Merge Commit Message
:}}
1941 merge
{set txt
{Merge Commit Message
:}}
1942 * {set txt
{Commit Message
:}}
1944 $ui_coml conf
-text $txt
1946 trace add variable commit_type
write trace_commit_type
1947 pack
$ui_coml -side left
-fill x
1948 pack .vpane.lower.commarea.buffer.header.amend
-side right
1949 pack .vpane.lower.commarea.buffer.header.new
-side right
1951 text
$ui_comm -background white
-borderwidth 1 \
1954 -autoseparators true \
1956 -width 75 -height 9 -wrap none \
1958 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
1959 scrollbar .vpane.lower.commarea.buffer.sby \
1960 -command [list
$ui_comm yview
]
1961 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
1962 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
1963 pack
$ui_comm -side left
-fill y
1964 pack .vpane.lower.commarea.buffer
-side left
-fill y
1966 # -- Commit Message Buffer Context Menu
1968 set ctxm .vpane.lower.commarea.buffer.ctxm
1969 menu
$ctxm -tearoff 0
1972 -command {tk_textCut
$ui_comm}
1975 -command {tk_textCopy
$ui_comm}
1978 -command {tk_textPaste
$ui_comm}
1981 -command {$ui_comm delete sel.first sel.last
}
1984 -label {Select All
} \
1985 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
1989 $ui_comm tag add sel
0.0 end
1990 tk_textCopy
$ui_comm
1991 $ui_comm tag remove sel
0.0 end
1997 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
2001 proc trace_current_diff_path
{varname args
} {
2002 global current_diff_path diff_actions file_states
2003 if {$current_diff_path eq
{}} {
2009 set p
$current_diff_path
2010 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2012 set p
[escape_path
$p]
2016 .vpane.lower.
diff.header.status configure
-text $s
2017 .vpane.lower.
diff.header.
file configure
-text $f
2018 .vpane.lower.
diff.header.path configure
-text $p
2019 foreach w
$diff_actions {
2023 trace add variable current_diff_path
write trace_current_diff_path
2025 frame .vpane.lower.
diff.header
-background gold
2026 label .vpane.lower.
diff.header.status \
2028 -width $max_status_desc \
2031 label .vpane.lower.
diff.header.
file \
2035 label .vpane.lower.
diff.header.path \
2039 pack .vpane.lower.
diff.header.status
-side left
2040 pack .vpane.lower.
diff.header.
file -side left
2041 pack .vpane.lower.
diff.header.path
-fill x
2042 set ctxm .vpane.lower.
diff.header.ctxm
2043 menu
$ctxm -tearoff 0
2051 -- $current_diff_path
2053 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2054 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2058 frame .vpane.lower.
diff.body
2059 set ui_diff .vpane.lower.
diff.body.t
2060 text
$ui_diff -background white
-borderwidth 0 \
2061 -width 80 -height 15 -wrap none \
2063 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2064 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2066 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2067 -command [list
$ui_diff xview
]
2068 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2069 -command [list
$ui_diff yview
]
2070 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2071 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2072 pack
$ui_diff -side left
-fill both
-expand 1
2073 pack .vpane.lower.
diff.header
-side top
-fill x
2074 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2076 $ui_diff tag conf d_cr
-elide true
2077 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
2078 $ui_diff tag conf d_
+ -foreground {#00a000}
2079 $ui_diff tag conf d_-
-foreground red
2081 $ui_diff tag conf d_
++ -foreground {#00a000}
2082 $ui_diff tag conf d_--
-foreground red
2083 $ui_diff tag conf d_
+s \
2084 -foreground {#00a000} \
2085 -background {#e2effa}
2086 $ui_diff tag conf d_-s \
2088 -background {#e2effa}
2089 $ui_diff tag conf d_s
+ \
2090 -foreground {#00a000} \
2092 $ui_diff tag conf d_s- \
2096 $ui_diff tag conf d
<<<<<<< \
2097 -foreground orange \
2099 $ui_diff tag conf d
======= \
2100 -foreground orange \
2102 $ui_diff tag conf d
>>>>>>> \
2103 -foreground orange \
2106 $ui_diff tag raise sel
2108 # -- Diff Body Context Menu
2110 set ctxm .vpane.lower.
diff.body.ctxm
2111 menu
$ctxm -tearoff 0
2114 -command reshow_diff
2115 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2118 -command {tk_textCopy
$ui_diff}
2119 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2121 -label {Select All
} \
2122 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
2123 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2127 $ui_diff tag add sel
0.0 end
2128 tk_textCopy
$ui_diff
2129 $ui_diff tag remove sel
0.0 end
2131 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2134 -label {Apply
/Reverse Hunk
} \
2135 -command {apply_hunk
$cursorX $cursorY}
2136 set ui_diff_applyhunk
[$ctxm index last
]
2137 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
2140 -label {Decrease Font Size
} \
2141 -command {incr_font_size font_diff
-1}
2142 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2144 -label {Increase Font Size
} \
2145 -command {incr_font_size font_diff
1}
2146 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2149 -label {Show Less Context
} \
2150 -command {if {$repo_config(gui.diffcontext
) >= 1} {
2151 incr repo_config
(gui.diffcontext
) -1
2154 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2156 -label {Show More Context
} \
2157 -command {if {$repo_config(gui.diffcontext
) < 99} {
2158 incr repo_config
(gui.diffcontext
)
2161 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2163 $ctxm add
command -label {Options...
} \
2165 bind_button3
$ui_diff "
2168 if {\$ui_index eq \$current_diff_side} {
2169 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
2171 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
2173 tk_popup $ctxm %X %Y
2175 unset ui_diff_applyhunk
2179 label .status
-textvariable ui_status_value \
2184 pack .status
-anchor w
-side bottom
-fill x
2189 set gm
$repo_config(gui.geometry
)
2190 wm geometry .
[lindex
$gm 0]
2191 .vpane sash place
0 \
2192 [lindex
[.vpane sash coord
0] 0] \
2194 .vpane.files sash place
0 \
2196 [lindex
[.vpane.files sash coord
0] 1]
2202 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2203 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
2204 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
2205 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2206 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2207 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2208 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2209 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2210 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2211 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2212 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2214 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2215 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2216 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2217 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2218 bind $ui_diff <$M1B-Key-v> {break}
2219 bind $ui_diff <$M1B-Key-V> {break}
2220 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2221 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2222 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2223 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2224 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2225 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2226 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
2227 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
2228 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
2229 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
2230 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
2231 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
2232 bind $ui_diff <Button-1
> {focus
%W
}
2234 if {[is_enabled branch
]} {
2235 bind .
<$M1B-Key-n> branch_create
::dialog
2236 bind .
<$M1B-Key-N> branch_create
::dialog
2238 if {[is_enabled transport
]} {
2239 bind .
<$M1B-Key-p> do_push_anywhere
2240 bind .
<$M1B-Key-P> do_push_anywhere
2243 bind .
<Key-F5
> do_rescan
2244 bind .
<$M1B-Key-r> do_rescan
2245 bind .
<$M1B-Key-R> do_rescan
2246 bind .
<$M1B-Key-s> do_signoff
2247 bind .
<$M1B-Key-S> do_signoff
2248 bind .
<$M1B-Key-i> do_add_all
2249 bind .
<$M1B-Key-I> do_add_all
2250 bind .
<$M1B-Key-Return> do_commit
2251 foreach i
[list
$ui_index $ui_workdir] {
2252 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2253 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2254 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2258 set file_lists
($ui_index) [list
]
2259 set file_lists
($ui_workdir) [list
]
2261 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2262 focus
-force $ui_comm
2264 # -- Warn the user about environmental problems. Cygwin's Tcl
2265 # does *not* pass its env array onto any processes it spawns.
2266 # This means that git processes get none of our environment.
2271 set msg
"Possible environment issues exist.
2273 The following environment variables are probably
2274 going to be ignored by any Git subprocess run
2278 foreach name
[array names env
] {
2279 switch
-regexp -- $name {
2280 {^GIT_INDEX_FILE$
} -
2281 {^GIT_OBJECT_DIRECTORY$
} -
2282 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
2284 {^GIT_EXTERNAL_DIFF$
} -
2288 {^GIT_CONFIG_LOCAL$
} -
2289 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
2290 append msg
" - $name\n"
2293 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
2294 append msg
" - $name\n"
2296 set suggest_user
$name
2300 if {$ignored_env > 0} {
2302 This is due to a known issue with the
2303 Tcl binary distributed by Cygwin."
2305 if {$suggest_user ne
{}} {
2308 A good replacement for $suggest_user
2309 is placing values for the user.name and
2310 user.email settings into your personal
2316 unset ignored_env msg suggest_user name
2319 # -- Only initialize complex UI if we are going to stay running.
2321 if {[is_enabled transport
]} {
2325 populate_branch_menu
2330 # -- Only suggest a gc run if we are going to stay running.
2332 if {[is_enabled multicommit
]} {
2333 set object_limit
2000
2334 if {[is_Windows
]} {set object_limit
200}
2335 regexp
{^
([0-9]+) objects
,} [git count-objects
] _junk objects_current
2336 if {$objects_current >= $object_limit} {
2338 "This repository currently has $objects_current loose objects.
2340 To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2342 Compress the database now?"] eq
yes} {
2346 unset object_limit _junk objects_current
2349 lock_index begin-read