2 # Tcl ignores the next line -*- tcl -*- \
5 set appvers
{@@GITGUI_VERSION@@
}
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
}
26 ######################################################################
30 set _appname
[lindex
[file split $argv0] end
]
46 return [eval [concat
[list
file join $_gitdir] $args]]
51 if {$_gitexec eq
{}} {
52 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
53 error
"Git not installed?\n\n$err"
59 return [eval [concat
[list
file join $_gitexec] $args]]
68 global tcl_platform tk_library
69 if {[tk windowingsystem
] eq
{aqua
}} {
77 if {$tcl_platform(platform
) eq
{windows
}} {
84 global tcl_platform _iscygwin
85 if {$_iscygwin eq
{}} {
86 if {$tcl_platform(platform
) eq
{windows
}} {
87 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
99 proc is_enabled
{option
} {
100 global enabled_options
101 if {[catch
{set on
$enabled_options($option)}]} {return 0}
105 proc enable_option
{option
} {
106 global enabled_options
107 set enabled_options
($option) 1
110 proc disable_option
{option
} {
111 global enabled_options
112 set enabled_options
($option) 0
115 ######################################################################
119 proc is_many_config
{name
} {
120 switch
-glob -- $name {
129 proc is_config_true
{name
} {
131 if {[catch
{set v
$repo_config($name)}]} {
133 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
140 proc load_config
{include_global
} {
141 global repo_config global_config default_config
143 array
unset global_config
144 if {$include_global} {
146 set fd_rc
[open
"| git config --global --list" r
]
147 while {[gets
$fd_rc line
] >= 0} {
148 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
149 if {[is_many_config
$name]} {
150 lappend global_config
($name) $value
152 set global_config
($name) $value
160 array
unset repo_config
162 set fd_rc
[open
"| git config --list" r
]
163 while {[gets
$fd_rc line
] >= 0} {
164 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
165 if {[is_many_config
$name]} {
166 lappend repo_config
($name) $value
168 set repo_config
($name) $value
175 foreach name
[array names default_config
] {
176 if {[catch
{set v
$global_config($name)}]} {
177 set global_config
($name) $default_config($name)
179 if {[catch
{set v
$repo_config($name)}]} {
180 set repo_config
($name) $default_config($name)
185 proc save_config
{} {
186 global default_config font_descs
187 global repo_config global_config
188 global repo_config_new global_config_new
190 foreach option
$font_descs {
191 set name
[lindex
$option 0]
192 set font
[lindex
$option 1]
193 font configure
$font \
194 -family $global_config_new(gui.
$font^^family
) \
195 -size $global_config_new(gui.
$font^^size
)
196 font configure
${font}bold \
197 -family $global_config_new(gui.
$font^^family
) \
198 -size $global_config_new(gui.
$font^^size
)
199 set global_config_new
(gui.
$name) [font configure
$font]
200 unset global_config_new
(gui.
$font^^family
)
201 unset global_config_new
(gui.
$font^^size
)
204 foreach name
[array names default_config
] {
205 set value
$global_config_new($name)
206 if {$value ne
$global_config($name)} {
207 if {$value eq
$default_config($name)} {
208 catch
{git config
--global --unset $name}
210 regsub
-all "\[{}\]" $value {"} value
211 git config --global $name $value
213 set global_config($name) $value
214 if {$value eq $repo_config($name)} {
215 catch {git config --unset $name}
216 set repo_config($name) $value
221 foreach name [array names default_config] {
222 set value $repo_config_new($name)
223 if {$value ne $repo_config($name)} {
224 if {$value eq $global_config($name)} {
225 catch {git config --unset $name}
227 regsub -all "\
[{}\
]" $value {"} value
228 git config
$name $value
230 set repo_config
($name) $value
235 ######################################################################
240 return [eval exec git
$args]
243 proc error_popup
{msg
} {
245 if {[reponame
] ne
{}} {
246 append title
" ([reponame])"
248 set cmd
[list tk_messageBox \
251 -title "$title: error" \
253 if {[winfo ismapped .
]} {
254 lappend cmd
-parent .
259 proc warn_popup
{msg
} {
261 if {[reponame
] ne
{}} {
262 append title
" ([reponame])"
264 set cmd
[list tk_messageBox \
267 -title "$title: warning" \
269 if {[winfo ismapped .
]} {
270 lappend cmd
-parent .
275 proc info_popup
{msg
{parent .
}} {
277 if {[reponame
] ne
{}} {
278 append title
" ([reponame])"
288 proc ask_popup
{msg
} {
290 if {[reponame
] ne
{}} {
291 append title
" ([reponame])"
293 return [tk_messageBox \
301 ######################################################################
308 if {[catch
{set v
[git
--version]} err
]} {
309 catch
{wm withdraw .
}
310 error_popup
"Cannot determine Git version:
314 [appname] requires Git $req_maj.$req_min or later."
317 if {[regexp
{^git version
(\d
+)\.
(\d
+)} $v _junk act_maj act_min
]} {
318 if {$act_maj < $req_maj
319 ||
($act_maj == $req_maj && $act_min < $req_min)} {
320 catch
{wm withdraw .
}
321 error_popup
"[appname] requires Git $req_maj.$req_min or later.
327 catch
{wm withdraw .
}
328 error_popup
"Cannot parse Git version string:\n\n$v"
331 unset -nocomplain v _junk act_maj act_min req_maj req_min
333 ######################################################################
337 if { [catch
{set _gitdir
$env(GIT_DIR
)}]
338 && [catch
{set _gitdir
[git rev-parse
--git-dir]} err
]} {
339 catch
{wm withdraw .
}
340 error_popup
"Cannot find the git directory:\n\n$err"
343 if {![file isdirectory
$_gitdir] && [is_Cygwin
]} {
344 catch
{set _gitdir
[exec cygpath
--unix $_gitdir]}
346 if {![file isdirectory
$_gitdir]} {
347 catch
{wm withdraw .
}
348 error_popup
"Git directory not found:\n\n$_gitdir"
351 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
352 catch
{wm withdraw .
}
353 error_popup
"Cannot use funny .git directory:\n\n$_gitdir"
356 if {[catch
{cd [file dirname $_gitdir]} err
]} {
357 catch
{wm withdraw .
}
358 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
361 set _reponame
[lindex
[file split \
362 [file normalize
[file dirname $_gitdir]]] \
365 ######################################################################
369 set current_diff_path
{}
370 set current_diff_side
{}
371 set diff_actions
[list
]
372 set ui_status_value
{Initializing...
}
376 set MERGE_HEAD
[list
]
379 set current_branch
{}
380 set current_diff_path
{}
381 set selected_commit_type new
383 ######################################################################
391 set disable_on_lock
[list
]
392 set index_lock_type none
394 proc lock_index
{type} {
395 global index_lock_type disable_on_lock
397 if {$index_lock_type eq
{none
}} {
398 set index_lock_type
$type
399 foreach w
$disable_on_lock {
400 uplevel
#0 $w disabled
403 } elseif
{$index_lock_type eq
"begin-$type"} {
404 set index_lock_type
$type
410 proc unlock_index
{} {
411 global index_lock_type disable_on_lock
413 set index_lock_type none
414 foreach w
$disable_on_lock {
419 ######################################################################
423 proc repository_state
{ctvar hdvar mhvar
} {
424 global current_branch
425 upvar
$ctvar ct
$hdvar hd
$mhvar mh
429 if {[catch
{set current_branch
[git symbolic-ref HEAD
]}]} {
430 set current_branch
{}
432 regsub ^refs
/((heads|tags|remotes
)/)? \
438 if {[catch
{set hd
[git rev-parse
--verify HEAD
]}]} {
444 set merge_head
[gitdir MERGE_HEAD
]
445 if {[file exists
$merge_head]} {
447 set fd_mh
[open
$merge_head r
]
448 while {[gets
$fd_mh line
] >= 0} {
459 global PARENT empty_tree
461 set p
[lindex
$PARENT 0]
465 if {$empty_tree eq
{}} {
466 set empty_tree
[git mktree
<< {}]
471 proc rescan
{after
{honor_trustmtime
1}} {
472 global HEAD PARENT MERGE_HEAD commit_type
473 global ui_index ui_workdir ui_status_value ui_comm
474 global rescan_active file_states
477 if {$rescan_active > 0 ||
![lock_index
read]} return
479 repository_state newType newHEAD newMERGE_HEAD
480 if {[string match amend
* $commit_type]
481 && $newType eq
{normal
}
482 && $newHEAD eq
$HEAD} {
486 set MERGE_HEAD
$newMERGE_HEAD
487 set commit_type
$newType
490 array
unset file_states
492 if {![$ui_comm edit modified
]
493 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
494 if {[load_message GITGUI_MSG
]} {
495 } elseif
{[load_message MERGE_MSG
]} {
496 } elseif
{[load_message SQUASH_MSG
]} {
499 $ui_comm edit modified false
502 if {[is_enabled branch
]} {
507 if {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
508 rescan_stage2
{} $after
511 set ui_status_value
{Refreshing
file status...
}
512 set cmd
[list git update-index
]
514 lappend cmd
--unmerged
515 lappend cmd
--ignore-missing
516 lappend cmd
--refresh
517 set fd_rf
[open
"| $cmd" r
]
518 fconfigure
$fd_rf -blocking 0 -translation binary
519 fileevent
$fd_rf readable \
520 [list rescan_stage2
$fd_rf $after]
524 proc rescan_stage2
{fd after
} {
525 global ui_status_value
526 global rescan_active buf_rdi buf_rdf buf_rlo
530 if {![eof
$fd]} return
534 set ls_others
[list | git ls-files
--others -z \
535 --exclude-per-directory=.gitignore
]
536 set info_exclude
[gitdir info exclude
]
537 if {[file readable
$info_exclude]} {
538 lappend ls_others
"--exclude-from=$info_exclude"
546 set ui_status_value
{Scanning
for modified files ...
}
547 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
548 set fd_df
[open
"| git diff-files -z" r
]
549 set fd_lo
[open
$ls_others r
]
551 fconfigure
$fd_di -blocking 0 -translation binary
-encoding binary
552 fconfigure
$fd_df -blocking 0 -translation binary
-encoding binary
553 fconfigure
$fd_lo -blocking 0 -translation binary
-encoding binary
554 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
555 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
556 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
559 proc load_message
{file} {
563 if {[file isfile
$f]} {
564 if {[catch
{set fd
[open
$f r
]}]} {
567 set content
[string trim
[read $fd]]
569 regsub
-all -line {[ \r\t]+$
} $content {} content
570 $ui_comm delete
0.0 end
571 $ui_comm insert end
$content
577 proc read_diff_index
{fd after
} {
580 append buf_rdi
[read $fd]
582 set n
[string length
$buf_rdi]
584 set z1
[string first
"\0" $buf_rdi $c]
587 set z2
[string first
"\0" $buf_rdi $z1]
591 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
592 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
594 [encoding convertfrom
$p] \
596 [list
[lindex
$i 0] [lindex
$i 2]] \
602 set buf_rdi
[string range
$buf_rdi $c end
]
607 rescan_done
$fd buf_rdi
$after
610 proc read_diff_files
{fd after
} {
613 append buf_rdf
[read $fd]
615 set n
[string length
$buf_rdf]
617 set z1
[string first
"\0" $buf_rdf $c]
620 set z2
[string first
"\0" $buf_rdf $z1]
624 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
625 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
627 [encoding convertfrom
$p] \
630 [list
[lindex
$i 0] [lindex
$i 2]]
635 set buf_rdf
[string range
$buf_rdf $c end
]
640 rescan_done
$fd buf_rdf
$after
643 proc read_ls_others
{fd after
} {
646 append buf_rlo
[read $fd]
647 set pck
[split $buf_rlo "\0"]
648 set buf_rlo
[lindex
$pck end
]
649 foreach p
[lrange
$pck 0 end-1
] {
650 merge_state
[encoding convertfrom
$p] ?O
652 rescan_done
$fd buf_rlo
$after
655 proc rescan_done
{fd buf after
} {
657 global file_states repo_config
660 if {![eof
$fd]} return
663 if {[incr rescan_active
-1] > 0} return
672 proc prune_selection
{} {
673 global file_states selected_paths
675 foreach path
[array names selected_paths
] {
676 if {[catch
{set still_here
$file_states($path)}]} {
677 unset selected_paths
($path)
682 ######################################################################
687 global ui_diff current_diff_path current_diff_header
688 global ui_index ui_workdir
690 $ui_diff conf
-state normal
691 $ui_diff delete
0.0 end
692 $ui_diff conf
-state disabled
694 set current_diff_path
{}
695 set current_diff_header
{}
697 $ui_index tag remove in_diff
0.0 end
698 $ui_workdir tag remove in_diff
0.0 end
701 proc reshow_diff
{} {
702 global ui_status_value file_states file_lists
703 global current_diff_path current_diff_side
705 set p
$current_diff_path
707 # No diff is being shown.
708 } elseif
{$current_diff_side eq
{}
709 ||
[catch
{set s
$file_states($p)}]
710 ||
[lsearch
-sorted -exact $file_lists($current_diff_side) $p] == -1} {
713 show_diff
$p $current_diff_side
717 proc handle_empty_diff
{} {
718 global current_diff_path file_states file_lists
720 set path
$current_diff_path
721 set s
$file_states($path)
722 if {[lindex
$s 0] ne
{_M
}} return
724 info_popup
"No differences detected.
726 [short_path $path] has no changes.
728 The modification date of this file was updated
729 by another application, but the content within
730 the file was not changed.
732 A rescan will be automatically started to find
733 other files which may have the same state."
736 display_file
$path __
737 rescan
{set ui_status_value
{Ready.
}} 0
740 proc show_diff
{path w
{lno
{}}} {
741 global file_states file_lists
742 global is_3way_diff diff_active repo_config
743 global ui_diff ui_status_value ui_index ui_workdir
744 global current_diff_path current_diff_side current_diff_header
746 if {$diff_active ||
![lock_index
read]} return
750 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
756 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
759 set s
$file_states($path)
763 set current_diff_path
$path
764 set current_diff_side
$w
765 set current_diff_header
{}
766 set ui_status_value
"Loading diff of [escape_path $path]..."
768 # - Git won't give us the diff, there's nothing to compare to!
771 set max_sz
[expr {128 * 1024}]
773 set fd
[open
$path r
]
774 set content
[read $fd $max_sz]
776 set sz
[file size
$path]
780 set ui_status_value
"Unable to display [escape_path $path]"
781 error_popup
"Error loading file:\n\n$err"
784 $ui_diff conf
-state normal
785 if {![catch
{set type [exec file $path]}]} {
786 set n
[string length
$path]
787 if {[string equal
-length $n $path $type]} {
788 set type [string range
$type $n end
]
789 regsub
{^
:?\s
*} $type {} type
791 $ui_diff insert end
"* $type\n" d_@
793 if {[string first
"\0" $content] != -1} {
794 $ui_diff insert end \
795 "* Binary file (not showing content)." \
799 $ui_diff insert end \
800 "* Untracked file is $sz bytes.
801 * Showing only first $max_sz bytes.
804 $ui_diff insert end
$content
806 $ui_diff insert end
"
807 * Untracked file clipped here by [appname].
808 * To see the entire file, use an external editor.
812 $ui_diff conf
-state disabled
815 set ui_status_value
{Ready.
}
820 if {$w eq
$ui_index} {
821 lappend cmd diff-index
823 } elseif
{$w eq
$ui_workdir} {
824 if {[string index
$m 0] eq
{U
}} {
827 lappend cmd diff-files
832 lappend cmd
--no-color
833 if {$repo_config(gui.diffcontext
) > 0} {
834 lappend cmd
"-U$repo_config(gui.diffcontext)"
836 if {$w eq
$ui_index} {
842 if {[catch
{set fd
[open
$cmd r
]} err
]} {
845 set ui_status_value
"Unable to display [escape_path $path]"
846 error_popup
"Error loading diff:\n\n$err"
854 fileevent
$fd readable
[list read_diff
$fd]
857 proc read_diff
{fd
} {
858 global ui_diff ui_status_value diff_active
859 global is_3way_diff current_diff_header
861 $ui_diff conf
-state normal
862 while {[gets
$fd line
] >= 0} {
863 # -- Cleanup uninteresting diff header lines.
865 if { [string match
{diff --git *} $line]
866 ||
[string match
{diff --cc *} $line]
867 ||
[string match
{diff --combined *} $line]
868 ||
[string match
{--- *} $line]
869 ||
[string match
{+++ *} $line]} {
870 append current_diff_header
$line "\n"
873 if {[string match
{index
*} $line]} continue
874 if {$line eq
{deleted
file mode
120000}} {
875 set line
"deleted symlink"
878 # -- Automatically detect if this is a 3 way diff.
880 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
882 if {[string match
{mode
*} $line]
883 ||
[string match
{new
file *} $line]
884 ||
[string match
{deleted
file *} $line]
885 ||
[string match
{Binary files
* and
* differ
} $line]
886 ||
$line eq
{\ No newline
at end of
file}
887 ||
[regexp
{^\
* Unmerged path
} $line]} {
889 } elseif
{$is_3way_diff} {
890 set op
[string range
$line 0 1]
900 if {[regexp
{^\
+\
+([<>]{7} |
={7})} $line _g op
]} {
901 set line
[string replace
$line 0 1 { }]
908 puts
"error: Unhandled 3 way diff marker: {$op}"
913 set op
[string index
$line 0]
919 if {[regexp
{^\
+([<>]{7} |
={7})} $line _g op
]} {
920 set line
[string replace
$line 0 0 { }]
927 puts
"error: Unhandled 2 way diff marker: {$op}"
932 $ui_diff insert end
$line $tags
933 if {[string index
$line end
] eq
"\r"} {
934 $ui_diff tag add d_cr
{end
- 2c
}
936 $ui_diff insert end
"\n" $tags
938 $ui_diff conf
-state disabled
944 set ui_status_value
{Ready.
}
946 if {[$ui_diff index end
] eq
{2.0}} {
952 proc apply_hunk
{x y
} {
953 global current_diff_path current_diff_header current_diff_side
954 global ui_diff ui_index file_states
956 if {$current_diff_path eq
{} ||
$current_diff_header eq
{}} return
957 if {![lock_index apply_hunk
]} return
959 set apply_cmd
{git apply
--cached --whitespace=nowarn
}
960 set mi
[lindex
$file_states($current_diff_path) 0]
961 if {$current_diff_side eq
$ui_index} {
963 lappend apply_cmd
--reverse
964 if {[string index
$mi 0] ne
{M
}} {
970 if {[string index
$mi 1] ne
{M
}} {
976 set s_lno
[lindex
[split [$ui_diff index @
$x,$y] .
] 0]
977 set s_lno
[$ui_diff search
-backwards -regexp ^@@
$s_lno.0 0.0]
983 set e_lno
[$ui_diff search
-forwards -regexp ^@@
"$s_lno + 1 lines" end
]
989 set p
[open
"| $apply_cmd" w
]
990 fconfigure
$p -translation binary
-encoding binary
991 puts
-nonewline $p $current_diff_header
992 puts
-nonewline $p [$ui_diff get
$s_lno $e_lno]
994 error_popup
"Failed to $mode selected hunk.\n\n$err"
999 $ui_diff conf
-state normal
1000 $ui_diff delete
$s_lno $e_lno
1001 $ui_diff conf
-state disabled
1003 if {[$ui_diff get
1.0 end
] eq
"\n"} {
1009 if {$current_diff_side eq
$ui_index} {
1011 } elseif
{[string index
$mi 0] eq
{_
}} {
1017 display_file
$current_diff_path $mi
1023 ######################################################################
1027 proc load_last_commit
{} {
1028 global HEAD PARENT MERGE_HEAD commit_type ui_comm
1031 if {[llength
$PARENT] == 0} {
1032 error_popup
{There is nothing to amend.
1034 You are about to create the initial commit.
1035 There is no commit before this to amend.
1040 repository_state curType curHEAD curMERGE_HEAD
1041 if {$curType eq
{merge
}} {
1042 error_popup
{Cannot amend
while merging.
1044 You are currently
in the middle of a merge that
1045 has not been fully completed. You cannot amend
1046 the prior commit unless you first abort the
1047 current merge activity.
1055 set fd
[open
"| git cat-file commit $curHEAD" r
]
1056 fconfigure
$fd -encoding binary
-translation lf
1057 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1060 while {[gets
$fd line
] > 0} {
1061 if {[string match
{parent
*} $line]} {
1062 lappend parents
[string range
$line 7 end
]
1063 } elseif
{[string match
{encoding
*} $line]} {
1064 set enc
[string tolower
[string range
$line 9 end
]]
1067 fconfigure
$fd -encoding $enc
1068 set msg
[string trim
[read $fd]]
1071 error_popup
"Error loading commit data for amend:\n\n$err"
1077 set MERGE_HEAD
[list
]
1078 switch
-- [llength
$parents] {
1079 0 {set commit_type amend-initial
}
1080 1 {set commit_type amend
}
1081 default
{set commit_type amend-merge
}
1084 $ui_comm delete
0.0 end
1085 $ui_comm insert end
$msg
1087 $ui_comm edit modified false
1088 rescan
{set ui_status_value
{Ready.
}}
1091 proc create_new_commit
{} {
1092 global commit_type ui_comm
1094 set commit_type normal
1095 $ui_comm delete
0.0 end
1097 $ui_comm edit modified false
1098 rescan
{set ui_status_value
{Ready.
}}
1101 set GIT_COMMITTER_IDENT
{}
1103 proc committer_ident
{} {
1104 global GIT_COMMITTER_IDENT
1106 if {$GIT_COMMITTER_IDENT eq
{}} {
1107 if {[catch
{set me
[git var GIT_COMMITTER_IDENT
]} err
]} {
1108 error_popup
"Unable to obtain your identity:\n\n$err"
1111 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
1112 $me me GIT_COMMITTER_IDENT
]} {
1113 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
1118 return $GIT_COMMITTER_IDENT
1121 proc commit_tree
{} {
1122 global HEAD commit_type file_states ui_comm repo_config
1123 global ui_status_value pch_error
1125 if {[committer_ident
] eq
{}} return
1126 if {![lock_index update
]} return
1128 # -- Our in memory state should match the repository.
1130 repository_state curType curHEAD curMERGE_HEAD
1131 if {[string match amend
* $commit_type]
1132 && $curType eq
{normal
}
1133 && $curHEAD eq
$HEAD} {
1134 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1135 info_popup
{Last scanned state does not match repository state.
1137 Another Git program has modified this repository
1138 since the last scan. A rescan must be performed
1139 before another commit can be created.
1141 The rescan will be automatically started now.
1144 rescan
{set ui_status_value
{Ready.
}}
1148 # -- At least one file should differ in the index.
1151 foreach path
[array names file_states
] {
1152 switch
-glob -- [lindex
$file_states($path) 0] {
1156 M?
{set files_ready
1}
1158 error_popup
"Unmerged files cannot be committed.
1160 File [short_path $path] has merge conflicts.
1161 You must resolve them and add the file before committing.
1167 error_popup
"Unknown file state [lindex $s 0] detected.
1169 File [short_path $path] cannot be committed by this program.
1174 if {!$files_ready} {
1175 info_popup
{No changes to commit.
1177 You must add
at least
1 file before you can commit.
1183 # -- A message is required.
1185 set msg
[string trim
[$ui_comm get
1.0 end
]]
1186 regsub
-all -line {[ \t\r]+$
} $msg {} msg
1188 error_popup
{Please supply a commit message.
1190 A good commit message has the following format
:
1192 - First line
: Describe
in one sentance what you did.
1193 - Second line
: Blank
1194 - Remaining lines
: Describe why this change is good.
1200 # -- Run the pre-commit hook.
1202 set pchook
[gitdir hooks pre-commit
]
1204 # On Cygwin [file executable] might lie so we need to ask
1205 # the shell if the hook is executable. Yes that's annoying.
1207 if {[is_Cygwin
] && [file isfile
$pchook]} {
1208 set pchook
[list sh
-c [concat \
1209 "if test -x \"$pchook\";" \
1210 "then exec \"$pchook\" 2>&1;" \
1212 } elseif
{[file executable
$pchook]} {
1213 set pchook
[list
$pchook |
& cat]
1215 commit_writetree
$curHEAD $msg
1219 set ui_status_value
{Calling pre-commit hook...
}
1221 set fd_ph
[open
"| $pchook" r
]
1222 fconfigure
$fd_ph -blocking 0 -translation binary
1223 fileevent
$fd_ph readable \
1224 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
1227 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
1228 global pch_error ui_status_value
1230 append pch_error
[read $fd_ph]
1231 fconfigure
$fd_ph -blocking 1
1233 if {[catch
{close
$fd_ph}]} {
1234 set ui_status_value
{Commit declined by pre-commit hook.
}
1235 hook_failed_popup pre-commit
$pch_error
1238 commit_writetree
$curHEAD $msg
1243 fconfigure
$fd_ph -blocking 0
1246 proc commit_writetree
{curHEAD msg
} {
1247 global ui_status_value
1249 set ui_status_value
{Committing changes...
}
1250 set fd_wt
[open
"| git write-tree" r
]
1251 fileevent
$fd_wt readable \
1252 [list commit_committree
$fd_wt $curHEAD $msg]
1255 proc commit_committree
{fd_wt curHEAD msg
} {
1256 global HEAD PARENT MERGE_HEAD commit_type
1257 global all_heads current_branch
1258 global ui_status_value ui_comm selected_commit_type
1259 global file_states selected_paths rescan_active
1263 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1264 error_popup
"write-tree failed:\n\n$err"
1265 set ui_status_value
{Commit failed.
}
1270 # -- Build the message.
1272 set msg_p
[gitdir COMMIT_EDITMSG
]
1273 set msg_wt
[open
$msg_p w
]
1274 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1277 fconfigure
$msg_wt -encoding $enc -translation binary
1278 puts
-nonewline $msg_wt $msg
1281 # -- Create the commit.
1283 set cmd
[list git commit-tree
$tree_id]
1284 set parents
[concat
$PARENT $MERGE_HEAD]
1285 if {[llength
$parents] > 0} {
1286 foreach p
$parents {
1290 # git commit-tree writes to stderr during initial commit.
1291 lappend cmd
2>/dev
/null
1294 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1295 error_popup
"commit-tree failed:\n\n$err"
1296 set ui_status_value
{Commit failed.
}
1301 # -- Update the HEAD ref.
1304 if {$commit_type ne
{normal
}} {
1305 append reflogm
" ($commit_type)"
1307 set i
[string first
"\n" $msg]
1309 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1311 append reflogm
{: } $msg
1313 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1314 if {[catch
{eval exec $cmd} err
]} {
1315 error_popup
"update-ref failed:\n\n$err"
1316 set ui_status_value
{Commit failed.
}
1321 # -- Make sure our current branch exists.
1323 if {$commit_type eq
{initial
}} {
1324 lappend all_heads
$current_branch
1325 set all_heads
[lsort
-unique $all_heads]
1326 populate_branch_menu
1329 # -- Cleanup after ourselves.
1331 catch
{file delete
$msg_p}
1332 catch
{file delete
[gitdir MERGE_HEAD
]}
1333 catch
{file delete
[gitdir MERGE_MSG
]}
1334 catch
{file delete
[gitdir SQUASH_MSG
]}
1335 catch
{file delete
[gitdir GITGUI_MSG
]}
1337 # -- Let rerere do its thing.
1339 if {[file isdirectory
[gitdir rr-cache
]]} {
1343 # -- Run the post-commit hook.
1345 set pchook
[gitdir hooks post-commit
]
1346 if {[is_Cygwin
] && [file isfile
$pchook]} {
1347 set pchook
[list sh
-c [concat \
1348 "if test -x \"$pchook\";" \
1349 "then exec \"$pchook\";" \
1351 } elseif
{![file executable
$pchook]} {
1354 if {$pchook ne
{}} {
1355 catch
{exec $pchook &}
1358 $ui_comm delete
0.0 end
1360 $ui_comm edit modified false
1362 if {[is_enabled singlecommit
]} do_quit
1364 # -- Update in memory status
1366 set selected_commit_type new
1367 set commit_type normal
1370 set MERGE_HEAD
[list
]
1372 foreach path
[array names file_states
] {
1373 set s
$file_states($path)
1375 switch
-glob -- $m {
1383 unset file_states
($path)
1384 catch
{unset selected_paths
($path)}
1387 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1393 set file_states
($path) [list \
1394 _
[string index
$m 1] \
1405 set ui_status_value \
1406 "Changes committed as [string range $cmt_id 0 7]."
1409 ######################################################################
1413 proc fetch_from
{remote
} {
1414 set w
[new_console \
1416 "Fetching new changes from $remote"]
1417 set cmd
[list git fetch
]
1419 console_exec
$w $cmd console_done
1422 proc push_to
{remote
} {
1423 set w
[new_console \
1425 "Pushing changes to $remote"]
1426 set cmd
[list git push
]
1429 console_exec
$w $cmd console_done
1432 ######################################################################
1436 proc mapicon
{w state path
} {
1439 if {[catch
{set r
$all_icons($state$w)}]} {
1440 puts
"error: no icon for $w state={$state} $path"
1446 proc mapdesc
{state path
} {
1449 if {[catch
{set r
$all_descs($state)}]} {
1450 puts
"error: no desc for state={$state} $path"
1456 proc escape_path
{path
} {
1457 regsub
-all {\\} $path "\\\\" path
1458 regsub
-all "\n" $path "\\n" path
1462 proc short_path
{path
} {
1463 return [escape_path
[lindex
[file split $path] end
]]
1467 set null_sha1
[string repeat
0 40]
1469 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1470 global file_states next_icon_id null_sha1
1472 set s0
[string index
$new_state 0]
1473 set s1
[string index
$new_state 1]
1475 if {[catch
{set info
$file_states($path)}]} {
1477 set icon n
[incr next_icon_id
]
1479 set state
[lindex
$info 0]
1480 set icon
[lindex
$info 1]
1481 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1482 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1485 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1486 elseif
{$s0 eq
{_
}} {set s0 _
}
1488 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1489 elseif
{$s1 eq
{_
}} {set s1 _
}
1491 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1492 set head_info
[list
0 $null_sha1]
1493 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1494 && $head_info eq
{}} {
1495 set head_info
$index_info
1498 set file_states
($path) [list
$s0$s1 $icon \
1499 $head_info $index_info \
1504 proc display_file_helper
{w path icon_name old_m new_m
} {
1507 if {$new_m eq
{_
}} {
1508 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1510 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1512 $w conf
-state normal
1513 $w delete
$lno.0 [expr {$lno + 1}].0
1514 $w conf
-state disabled
1516 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1517 lappend file_lists
($w) $path
1518 set file_lists
($w) [lsort
-unique $file_lists($w)]
1519 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1521 $w conf
-state normal
1522 $w image create
$lno.0 \
1523 -align center
-padx 5 -pady 1 \
1525 -image [mapicon
$w $new_m $path]
1526 $w insert
$lno.1 "[escape_path $path]\n"
1527 $w conf
-state disabled
1528 } elseif
{$old_m ne
$new_m} {
1529 $w conf
-state normal
1530 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1531 $w conf
-state disabled
1535 proc display_file
{path state
} {
1536 global file_states selected_paths
1537 global ui_index ui_workdir
1539 set old_m
[merge_state
$path $state]
1540 set s
$file_states($path)
1541 set new_m
[lindex
$s 0]
1542 set icon_name
[lindex
$s 1]
1544 set o
[string index
$old_m 0]
1545 set n
[string index
$new_m 0]
1552 display_file_helper
$ui_index $path $icon_name $o $n
1554 if {[string index
$old_m 0] eq
{U
}} {
1557 set o
[string index
$old_m 1]
1559 if {[string index
$new_m 0] eq
{U
}} {
1562 set n
[string index
$new_m 1]
1564 display_file_helper
$ui_workdir $path $icon_name $o $n
1566 if {$new_m eq
{__
}} {
1567 unset file_states
($path)
1568 catch
{unset selected_paths
($path)}
1572 proc display_all_files_helper
{w path icon_name m
} {
1575 lappend file_lists
($w) $path
1576 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1577 $w image create end \
1578 -align center
-padx 5 -pady 1 \
1580 -image [mapicon
$w $m $path]
1581 $w insert end
"[escape_path $path]\n"
1584 proc display_all_files
{} {
1585 global ui_index ui_workdir
1586 global file_states file_lists
1589 $ui_index conf
-state normal
1590 $ui_workdir conf
-state normal
1592 $ui_index delete
0.0 end
1593 $ui_workdir delete
0.0 end
1596 set file_lists
($ui_index) [list
]
1597 set file_lists
($ui_workdir) [list
]
1599 foreach path
[lsort
[array names file_states
]] {
1600 set s
$file_states($path)
1602 set icon_name
[lindex
$s 1]
1604 set s
[string index
$m 0]
1605 if {$s ne
{U
} && $s ne
{_
}} {
1606 display_all_files_helper
$ui_index $path \
1610 if {[string index
$m 0] eq
{U
}} {
1613 set s
[string index
$m 1]
1616 display_all_files_helper
$ui_workdir $path \
1621 $ui_index conf
-state disabled
1622 $ui_workdir conf
-state disabled
1625 proc update_indexinfo
{msg pathList after
} {
1626 global update_index_cp ui_status_value
1628 if {![lock_index update
]} return
1630 set update_index_cp
0
1631 set pathList
[lsort
$pathList]
1632 set totalCnt
[llength
$pathList]
1633 set batch [expr {int
($totalCnt * .01) + 1}]
1634 if {$batch > 25} {set batch 25}
1636 set ui_status_value
[format \
1637 "$msg... %i/%i files (%.2f%%)" \
1641 set fd
[open
"| git update-index -z --index-info" w
]
1648 fileevent
$fd writable
[list \
1649 write_update_indexinfo \
1659 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1660 global update_index_cp ui_status_value
1661 global file_states current_diff_path
1663 if {$update_index_cp >= $totalCnt} {
1670 for {set i
$batch} \
1671 {$update_index_cp < $totalCnt && $i > 0} \
1673 set path
[lindex
$pathList $update_index_cp]
1674 incr update_index_cp
1676 set s
$file_states($path)
1677 switch
-glob -- [lindex
$s 0] {
1684 set info
[lindex
$s 2]
1685 if {$info eq
{}} continue
1687 puts
-nonewline $fd "$info\t[encoding convertto $path]\0"
1688 display_file
$path $new
1691 set ui_status_value
[format \
1692 "$msg... %i/%i files (%.2f%%)" \
1695 [expr {100.0 * $update_index_cp / $totalCnt}]]
1698 proc update_index
{msg pathList after
} {
1699 global update_index_cp ui_status_value
1701 if {![lock_index update
]} return
1703 set update_index_cp
0
1704 set pathList
[lsort
$pathList]
1705 set totalCnt
[llength
$pathList]
1706 set batch [expr {int
($totalCnt * .01) + 1}]
1707 if {$batch > 25} {set batch 25}
1709 set ui_status_value
[format \
1710 "$msg... %i/%i files (%.2f%%)" \
1714 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1721 fileevent
$fd writable
[list \
1722 write_update_index \
1732 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1733 global update_index_cp ui_status_value
1734 global file_states current_diff_path
1736 if {$update_index_cp >= $totalCnt} {
1743 for {set i
$batch} \
1744 {$update_index_cp < $totalCnt && $i > 0} \
1746 set path
[lindex
$pathList $update_index_cp]
1747 incr update_index_cp
1749 switch
-glob -- [lindex
$file_states($path) 0] {
1755 if {[file exists
$path]} {
1764 puts
-nonewline $fd "[encoding convertto $path]\0"
1765 display_file
$path $new
1768 set ui_status_value
[format \
1769 "$msg... %i/%i files (%.2f%%)" \
1772 [expr {100.0 * $update_index_cp / $totalCnt}]]
1775 proc checkout_index
{msg pathList after
} {
1776 global update_index_cp ui_status_value
1778 if {![lock_index update
]} return
1780 set update_index_cp
0
1781 set pathList
[lsort
$pathList]
1782 set totalCnt
[llength
$pathList]
1783 set batch [expr {int
($totalCnt * .01) + 1}]
1784 if {$batch > 25} {set batch 25}
1786 set ui_status_value
[format \
1787 "$msg... %i/%i files (%.2f%%)" \
1791 set cmd
[list git checkout-index
]
1797 set fd
[open
"| $cmd " w
]
1804 fileevent
$fd writable
[list \
1805 write_checkout_index \
1815 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1816 global update_index_cp ui_status_value
1817 global file_states current_diff_path
1819 if {$update_index_cp >= $totalCnt} {
1826 for {set i
$batch} \
1827 {$update_index_cp < $totalCnt && $i > 0} \
1829 set path
[lindex
$pathList $update_index_cp]
1830 incr update_index_cp
1831 switch
-glob -- [lindex
$file_states($path) 0] {
1835 puts
-nonewline $fd "[encoding convertto $path]\0"
1836 display_file
$path ?_
1841 set ui_status_value
[format \
1842 "$msg... %i/%i files (%.2f%%)" \
1845 [expr {100.0 * $update_index_cp / $totalCnt}]]
1848 ######################################################################
1850 ## branch management
1852 proc is_tracking_branch
{name
} {
1853 global tracking_branches
1855 if {![catch
{set info
$tracking_branches($name)}]} {
1858 foreach t
[array names tracking_branches
] {
1859 if {[string match
{*/\
*} $t] && [string match
$t $name]} {
1866 proc load_all_heads
{} {
1869 set all_heads
[list
]
1870 set fd
[open
"| git for-each-ref --format=%(refname) refs/heads" r
]
1871 while {[gets
$fd line
] > 0} {
1872 if {[is_tracking_branch
$line]} continue
1873 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1874 lappend all_heads
$name
1878 set all_heads
[lsort
$all_heads]
1881 proc populate_branch_menu
{} {
1882 global all_heads disable_on_lock
1885 set last
[$m index last
]
1886 for {set i
0} {$i <= $last} {incr i
} {
1887 if {[$m type $i] eq
{separator
}} {
1890 foreach a
$disable_on_lock {
1891 if {[lindex
$a 0] ne
$m ||
[lindex
$a 2] < $i} {
1895 set disable_on_lock
$new_dol
1900 if {$all_heads ne
{}} {
1903 foreach b
$all_heads {
1904 $m add radiobutton \
1906 -command [list switch_branch
$b] \
1907 -variable current_branch \
1910 lappend disable_on_lock \
1911 [list
$m entryconf
[$m index last
] -state]
1915 proc all_tracking_branches
{} {
1916 global tracking_branches
1918 set all_trackings
{}
1920 foreach name
[array names tracking_branches
] {
1921 if {[regsub
{/\
*$
} $name {} name
]} {
1924 regsub ^refs
/(heads|remotes
)/ $name {} name
1925 lappend all_trackings
$name
1930 set fd
[open
"| git for-each-ref --format=%(refname) $cmd" r
]
1931 while {[gets
$fd name
] > 0} {
1932 regsub ^refs
/(heads|remotes
)/ $name {} name
1933 lappend all_trackings
$name
1938 return [lsort
-unique $all_trackings]
1941 proc load_all_tags
{} {
1943 set fd
[open
"| git for-each-ref --format=%(refname) refs/tags" r
]
1944 while {[gets
$fd line
] > 0} {
1945 if {![regsub ^refs
/tags
/ $line {} name
]} continue
1946 lappend all_tags
$name
1950 return [lsort
$all_tags]
1953 proc do_create_branch_action
{w
} {
1954 global all_heads null_sha1 repo_config
1955 global create_branch_checkout create_branch_revtype
1956 global create_branch_head create_branch_trackinghead
1957 global create_branch_name create_branch_revexp
1958 global create_branch_tag
1960 set newbranch
$create_branch_name
1961 if {$newbranch eq
{}
1962 ||
$newbranch eq
$repo_config(gui.newbranchtemplate
)} {
1966 -title [wm title
$w] \
1968 -message "Please supply a branch name."
1969 focus
$w.desc.name_t
1972 if {![catch
{git show-ref
--verify -- "refs/heads/$newbranch"}]} {
1976 -title [wm title
$w] \
1978 -message "Branch '$newbranch' already exists."
1979 focus
$w.desc.name_t
1982 if {[catch
{git check-ref-format
"heads/$newbranch"}]} {
1986 -title [wm title
$w] \
1988 -message "We do not like '$newbranch' as a branch name."
1989 focus
$w.desc.name_t
1994 switch
-- $create_branch_revtype {
1995 head {set rev $create_branch_head}
1996 tracking
{set rev $create_branch_trackinghead}
1997 tag
{set rev $create_branch_tag}
1998 expression
{set rev $create_branch_revexp}
2000 if {[catch
{set cmt
[git rev-parse
--verify "${rev}^0"]}]} {
2004 -title [wm title
$w] \
2006 -message "Invalid starting revision: $rev"
2009 set cmd
[list git update-ref
]
2011 lappend cmd
"branch: Created from $rev"
2012 lappend cmd
"refs/heads/$newbranch"
2014 lappend cmd
$null_sha1
2015 if {[catch
{eval exec $cmd} err
]} {
2019 -title [wm title
$w] \
2021 -message "Failed to create '$newbranch'.\n\n$err"
2025 lappend all_heads
$newbranch
2026 set all_heads
[lsort
$all_heads]
2027 populate_branch_menu
2029 if {$create_branch_checkout} {
2030 switch_branch
$newbranch
2034 proc radio_selector
{varname value args
} {
2035 upvar
#0 $varname var
2039 trace add variable create_branch_head
write \
2040 [list radio_selector create_branch_revtype
head]
2041 trace add variable create_branch_trackinghead
write \
2042 [list radio_selector create_branch_revtype tracking
]
2043 trace add variable create_branch_tag
write \
2044 [list radio_selector create_branch_revtype tag
]
2046 trace add variable delete_branch_head
write \
2047 [list radio_selector delete_branch_checktype
head]
2048 trace add variable delete_branch_trackinghead
write \
2049 [list radio_selector delete_branch_checktype tracking
]
2051 proc do_create_branch
{} {
2052 global all_heads current_branch repo_config
2053 global create_branch_checkout create_branch_revtype
2054 global create_branch_head create_branch_trackinghead
2055 global create_branch_name create_branch_revexp
2056 global create_branch_tag
2058 set w .branch_editor
2060 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2062 label
$w.header
-text {Create New Branch
} \
2064 pack
$w.header
-side top
-fill x
2067 button
$w.buttons.create
-text Create \
2070 -command [list do_create_branch_action
$w]
2071 pack
$w.buttons.create
-side right
2072 button
$w.buttons.cancel
-text {Cancel
} \
2074 -command [list destroy
$w]
2075 pack
$w.buttons.cancel
-side right
-padx 5
2076 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2078 labelframe
$w.desc \
2079 -text {Branch Description
} \
2081 label
$w.desc.name_l
-text {Name
:} -font font_ui
2082 entry
$w.desc.name_t \
2086 -textvariable create_branch_name \
2090 if {%d
== 1 && [regexp
{[~^
:?
*\
[\
0- ]} %S
]} {return 0}
2093 grid
$w.desc.name_l
$w.desc.name_t
-sticky we
-padx {0 5}
2094 grid columnconfigure
$w.desc
1 -weight 1
2095 pack
$w.desc
-anchor nw
-fill x
-pady 5 -padx 5
2097 labelframe
$w.from \
2098 -text {Starting Revision
} \
2100 radiobutton
$w.from.head_r \
2101 -text {Local Branch
:} \
2103 -variable create_branch_revtype \
2105 eval tk_optionMenu
$w.from.head_m create_branch_head
$all_heads
2106 grid
$w.from.head_r
$w.from.head_m
-sticky w
2107 set all_trackings
[all_tracking_branches
]
2108 if {$all_trackings ne
{}} {
2109 set create_branch_trackinghead
[lindex
$all_trackings 0]
2110 radiobutton
$w.from.tracking_r \
2111 -text {Tracking Branch
:} \
2113 -variable create_branch_revtype \
2115 eval tk_optionMenu
$w.from.tracking_m \
2116 create_branch_trackinghead \
2118 grid
$w.from.tracking_r
$w.from.tracking_m
-sticky w
2120 set all_tags
[load_all_tags
]
2121 if {$all_tags ne
{}} {
2122 set create_branch_tag
[lindex
$all_tags 0]
2123 radiobutton
$w.from.tag_r \
2126 -variable create_branch_revtype \
2128 eval tk_optionMenu
$w.from.tag_m \
2131 grid
$w.from.tag_r
$w.from.tag_m
-sticky w
2133 radiobutton
$w.from.exp_r \
2134 -text {Revision Expression
:} \
2136 -variable create_branch_revtype \
2138 entry
$w.from.exp_t \
2142 -textvariable create_branch_revexp \
2146 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2147 if {%d
== 1 && [string length
%S
] > 0} {
2148 set create_branch_revtype expression
2152 grid
$w.from.exp_r
$w.from.exp_t
-sticky we
-padx {0 5}
2153 grid columnconfigure
$w.from
1 -weight 1
2154 pack
$w.from
-anchor nw
-fill x
-pady 5 -padx 5
2156 labelframe
$w.postActions \
2157 -text {Post Creation Actions
} \
2159 checkbutton
$w.postActions.checkout \
2160 -text {Checkout after creation
} \
2161 -variable create_branch_checkout \
2163 pack
$w.postActions.checkout
-anchor nw
2164 pack
$w.postActions
-anchor nw
-fill x
-pady 5 -padx 5
2166 set create_branch_checkout
1
2167 set create_branch_head
$current_branch
2168 set create_branch_revtype
head
2169 set create_branch_name
$repo_config(gui.newbranchtemplate
)
2170 set create_branch_revexp
{}
2172 bind $w <Visibility
> "
2174 $w.desc.name_t icursor end
2175 focus $w.desc.name_t
2177 bind $w <Key-Escape
> "destroy $w"
2178 bind $w <Key-Return
> "do_create_branch_action $w;break"
2179 wm title
$w "[appname] ([reponame]): Create Branch"
2183 proc do_delete_branch_action
{w
} {
2185 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2188 switch
-- $delete_branch_checktype {
2189 head {set check_rev
$delete_branch_head}
2190 tracking
{set check_rev
$delete_branch_trackinghead}
2191 always
{set check_rev
{:none
}}
2193 if {$check_rev eq
{:none
}} {
2195 } elseif
{[catch
{set check_cmt
[git rev-parse
--verify "${check_rev}^0"]}]} {
2199 -title [wm title
$w] \
2201 -message "Invalid check revision: $check_rev"
2205 set to_delete
[list
]
2206 set not_merged
[list
]
2207 foreach i
[$w.list.l curselection
] {
2208 set b
[$w.list.l get
$i]
2209 if {[catch
{set o
[git rev-parse
--verify $b]}]} continue
2210 if {$check_cmt ne
{}} {
2211 if {$b eq
$check_rev} continue
2212 if {[catch
{set m
[git merge-base
$o $check_cmt]}]} continue
2214 lappend not_merged
$b
2218 lappend to_delete
[list
$b $o]
2220 if {$not_merged ne
{}} {
2221 set msg
"The following branches are not completely merged into $check_rev:
2223 - [join $not_merged "\n - "]"
2227 -title [wm title
$w] \
2231 if {$to_delete eq
{}} return
2232 if {$delete_branch_checktype eq
{always
}} {
2233 set msg
{Recovering deleted branches is difficult.
2235 Delete the selected branches?
}
2236 if {[tk_messageBox \
2239 -title [wm title
$w] \
2241 -message $msg] ne
yes} {
2247 foreach i
$to_delete {
2250 if {[catch
{git update-ref
-d "refs/heads/$b" $o} err
]} {
2251 append failed
" - $b: $err\n"
2253 set x
[lsearch
-sorted -exact $all_heads $b]
2255 set all_heads
[lreplace
$all_heads $x $x]
2260 if {$failed ne
{}} {
2264 -title [wm title
$w] \
2266 -message "Failed to delete branches:\n$failed"
2269 set all_heads
[lsort
$all_heads]
2270 populate_branch_menu
2274 proc do_delete_branch
{} {
2275 global all_heads tracking_branches current_branch
2276 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2278 set w .branch_editor
2280 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2282 label
$w.header
-text {Delete Local Branch
} \
2284 pack
$w.header
-side top
-fill x
2287 button
$w.buttons.create
-text Delete \
2289 -command [list do_delete_branch_action
$w]
2290 pack
$w.buttons.create
-side right
2291 button
$w.buttons.cancel
-text {Cancel
} \
2293 -command [list destroy
$w]
2294 pack
$w.buttons.cancel
-side right
-padx 5
2295 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2297 labelframe
$w.list \
2298 -text {Local Branches
} \
2303 -selectmode extended \
2304 -yscrollcommand [list
$w.list.sby
set] \
2306 foreach h
$all_heads {
2307 if {$h ne
$current_branch} {
2308 $w.list.l insert end
$h
2311 scrollbar
$w.list.sby
-command [list
$w.list.l yview
]
2312 pack
$w.list.sby
-side right
-fill y
2313 pack
$w.list.l
-side left
-fill both
-expand 1
2314 pack
$w.list
-fill both
-expand 1 -pady 5 -padx 5
2316 labelframe
$w.validate \
2317 -text {Delete Only If
} \
2319 radiobutton
$w.validate.head_r \
2320 -text {Merged Into Local Branch
:} \
2322 -variable delete_branch_checktype \
2324 eval tk_optionMenu
$w.validate.head_m delete_branch_head
$all_heads
2325 grid
$w.validate.head_r
$w.validate.head_m
-sticky w
2326 set all_trackings
[all_tracking_branches
]
2327 if {$all_trackings ne
{}} {
2328 set delete_branch_trackinghead
[lindex
$all_trackings 0]
2329 radiobutton
$w.validate.tracking_r \
2330 -text {Merged Into Tracking Branch
:} \
2332 -variable delete_branch_checktype \
2334 eval tk_optionMenu
$w.validate.tracking_m \
2335 delete_branch_trackinghead \
2337 grid
$w.validate.tracking_r
$w.validate.tracking_m
-sticky w
2339 radiobutton
$w.validate.always_r \
2340 -text {Always
(Do not perform merge checks
)} \
2342 -variable delete_branch_checktype \
2344 grid
$w.validate.always_r
-columnspan 2 -sticky w
2345 grid columnconfigure
$w.validate
1 -weight 1
2346 pack
$w.validate
-anchor nw
-fill x
-pady 5 -padx 5
2348 set delete_branch_head
$current_branch
2349 set delete_branch_checktype
head
2351 bind $w <Visibility
> "grab $w; focus $w"
2352 bind $w <Key-Escape
> "destroy $w"
2353 wm title
$w "[appname] ([reponame]): Delete Branch"
2357 proc switch_branch
{new_branch
} {
2358 global HEAD commit_type current_branch repo_config
2360 if {![lock_index switch
]} return
2362 # -- Our in memory state should match the repository.
2364 repository_state curType curHEAD curMERGE_HEAD
2365 if {[string match amend
* $commit_type]
2366 && $curType eq
{normal
}
2367 && $curHEAD eq
$HEAD} {
2368 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2369 info_popup
{Last scanned state does not match repository state.
2371 Another Git program has modified this repository
2372 since the last scan. A rescan must be performed
2373 before the current branch can be changed.
2375 The rescan will be automatically started now.
2378 rescan
{set ui_status_value
{Ready.
}}
2382 # -- Don't do a pointless switch.
2384 if {$current_branch eq
$new_branch} {
2389 if {$repo_config(gui.trustmtime
) eq
{true
}} {
2390 switch_branch_stage2
{} $new_branch
2392 set ui_status_value
{Refreshing
file status...
}
2393 set cmd
[list git update-index
]
2395 lappend cmd
--unmerged
2396 lappend cmd
--ignore-missing
2397 lappend cmd
--refresh
2398 set fd_rf
[open
"| $cmd" r
]
2399 fconfigure
$fd_rf -blocking 0 -translation binary
2400 fileevent
$fd_rf readable \
2401 [list switch_branch_stage2
$fd_rf $new_branch]
2405 proc switch_branch_stage2
{fd_rf new_branch
} {
2406 global ui_status_value HEAD
2410 if {![eof
$fd_rf]} return
2414 set ui_status_value
"Updating working directory to '$new_branch'..."
2415 set cmd
[list git read-tree
]
2418 lappend cmd
--exclude-per-directory=.gitignore
2420 lappend cmd
$new_branch
2421 set fd_rt
[open
"| $cmd" r
]
2422 fconfigure
$fd_rt -blocking 0 -translation binary
2423 fileevent
$fd_rt readable \
2424 [list switch_branch_readtree_wait
$fd_rt $new_branch]
2427 proc switch_branch_readtree_wait
{fd_rt new_branch
} {
2428 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2429 global current_branch
2430 global ui_comm ui_status_value
2432 # -- We never get interesting output on stdout; only stderr.
2435 fconfigure
$fd_rt -blocking 1
2436 if {![eof
$fd_rt]} {
2437 fconfigure
$fd_rt -blocking 0
2441 # -- The working directory wasn't in sync with the index and
2442 # we'd have to overwrite something to make the switch. A
2443 # merge is required.
2445 if {[catch
{close
$fd_rt} err
]} {
2446 regsub
{^fatal
: } $err {} err
2447 warn_popup
"File level merge required.
2451 Staying on branch '$current_branch'."
2452 set ui_status_value
"Aborted checkout of '$new_branch' (file level merging is required)."
2457 # -- Update the symbolic ref. Core git doesn't even check for failure
2458 # here, it Just Works(tm). If it doesn't we are in some really ugly
2459 # state that is difficult to recover from within git-gui.
2461 if {[catch
{git symbolic-ref HEAD
"refs/heads/$new_branch"} err
]} {
2462 error_popup
"Failed to set current branch.
2464 This working directory is only partially switched.
2465 We successfully updated your files, but failed to
2466 update an internal Git file.
2468 This should not have occurred. [appname] will now
2476 # -- Update our repository state. If we were previously in amend mode
2477 # we need to toss the current buffer and do a full rescan to update
2478 # our file lists. If we weren't in amend mode our file lists are
2479 # accurate and we can avoid the rescan.
2482 set selected_commit_type new
2483 if {[string match amend
* $commit_type]} {
2484 $ui_comm delete
0.0 end
2486 $ui_comm edit modified false
2487 rescan
{set ui_status_value
"Checked out branch '$current_branch'."}
2489 repository_state commit_type HEAD MERGE_HEAD
2491 set ui_status_value
"Checked out branch '$current_branch'."
2495 ######################################################################
2497 ## remote management
2499 proc load_all_remotes
{} {
2501 global all_remotes tracking_branches
2503 set all_remotes
[list
]
2504 array
unset tracking_branches
2506 set rm_dir
[gitdir remotes
]
2507 if {[file isdirectory
$rm_dir]} {
2508 set all_remotes
[glob \
2512 -directory $rm_dir *]
2514 foreach name
$all_remotes {
2516 set fd
[open
[file join $rm_dir $name] r
]
2517 while {[gets
$fd line
] >= 0} {
2518 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
2519 $line line src dst
]} continue
2520 if {![regexp ^refs
/ $dst]} {
2521 set dst
"refs/heads/$dst"
2523 set tracking_branches
($dst) [list
$name $src]
2530 foreach line
[array names repo_config remote.
*.url
] {
2531 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
2532 lappend all_remotes
$name
2534 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
2538 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
2539 if {![regexp ^refs
/ $dst]} {
2540 set dst
"refs/heads/$dst"
2542 set tracking_branches
($dst) [list
$name $src]
2546 set all_remotes
[lsort
-unique $all_remotes]
2549 proc populate_fetch_menu
{} {
2550 global all_remotes repo_config
2553 foreach r
$all_remotes {
2555 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2556 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
2561 set fd
[open
[gitdir remotes
$r] r
]
2562 while {[gets
$fd n
] >= 0} {
2563 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
2574 -label "Fetch from $r..." \
2575 -command [list fetch_from
$r] \
2581 proc populate_push_menu
{} {
2582 global all_remotes repo_config
2586 foreach r
$all_remotes {
2588 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2589 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
2594 set fd
[open
[gitdir remotes
$r] r
]
2595 while {[gets
$fd n
] >= 0} {
2596 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
2610 -label "Push to $r..." \
2611 -command [list push_to
$r] \
2618 proc start_push_anywhere_action
{w
} {
2619 global push_urltype push_remote push_url push_thin push_tags
2622 switch
-- $push_urltype {
2623 remote
{set r_url
$push_remote}
2624 url
{set r_url
$push_url}
2626 if {$r_url eq
{}} return
2628 set cmd
[list git push
]
2638 foreach i
[$w.
source.l curselection
] {
2639 set b
[$w.
source.l get
$i]
2640 lappend cmd
"refs/heads/$b:refs/heads/$b"
2645 } elseif
{$cnt == 1} {
2651 set cons
[new_console
"push $r_url" "Pushing $cnt $unit to $r_url"]
2652 console_exec
$cons $cmd console_done
2656 trace add variable push_remote
write \
2657 [list radio_selector push_urltype remote
]
2659 proc do_push_anywhere
{} {
2660 global all_heads all_remotes current_branch
2661 global push_urltype push_remote push_url push_thin push_tags
2665 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2667 label
$w.header
-text {Push Branches
} -font font_uibold
2668 pack
$w.header
-side top
-fill x
2671 button
$w.buttons.create
-text Push \
2673 -command [list start_push_anywhere_action
$w]
2674 pack
$w.buttons.create
-side right
2675 button
$w.buttons.cancel
-text {Cancel
} \
2677 -command [list destroy
$w]
2678 pack
$w.buttons.cancel
-side right
-padx 5
2679 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2681 labelframe
$w.
source \
2682 -text {Source Branches
} \
2684 listbox
$w.
source.l \
2687 -selectmode extended \
2688 -yscrollcommand [list
$w.
source.sby
set] \
2690 foreach h
$all_heads {
2691 $w.
source.l insert end
$h
2692 if {$h eq
$current_branch} {
2693 $w.
source.l
select set end
2696 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2697 pack
$w.
source.sby
-side right
-fill y
2698 pack
$w.
source.l
-side left
-fill both
-expand 1
2699 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2701 labelframe
$w.dest \
2702 -text {Destination Repository
} \
2704 if {$all_remotes ne
{}} {
2705 radiobutton
$w.dest.remote_r \
2708 -variable push_urltype \
2710 eval tk_optionMenu
$w.dest.remote_m push_remote
$all_remotes
2711 grid
$w.dest.remote_r
$w.dest.remote_m
-sticky w
2712 if {[lsearch
-sorted -exact $all_remotes origin
] != -1} {
2713 set push_remote origin
2715 set push_remote
[lindex
$all_remotes 0]
2717 set push_urltype remote
2719 set push_urltype url
2721 radiobutton
$w.dest.url_r \
2722 -text {Arbitrary URL
:} \
2724 -variable push_urltype \
2726 entry
$w.dest.url_t \
2730 -textvariable push_url \
2734 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2735 if {%d
== 1 && [string length
%S
] > 0} {
2736 set push_urltype url
2740 grid
$w.dest.url_r
$w.dest.url_t
-sticky we
-padx {0 5}
2741 grid columnconfigure
$w.dest
1 -weight 1
2742 pack
$w.dest
-anchor nw
-fill x
-pady 5 -padx 5
2744 labelframe
$w.options \
2745 -text {Transfer Options
} \
2747 checkbutton
$w.options.thin \
2748 -text {Use thin pack
(for slow network connections
)} \
2749 -variable push_thin \
2751 grid
$w.options.thin
-columnspan 2 -sticky w
2752 checkbutton
$w.options.tags \
2753 -text {Include tags
} \
2754 -variable push_tags \
2756 grid
$w.options.tags
-columnspan 2 -sticky w
2757 grid columnconfigure
$w.options
1 -weight 1
2758 pack
$w.options
-anchor nw
-fill x
-pady 5 -padx 5
2764 bind $w <Visibility
> "grab $w"
2765 bind $w <Key-Escape
> "destroy $w"
2766 wm title
$w "[appname] ([reponame]): Push"
2770 ######################################################################
2775 global HEAD commit_type file_states
2777 if {[string match amend
* $commit_type]} {
2778 info_popup
{Cannot merge
while amending.
2780 You must finish amending this commit before
2781 starting any
type of merge.
2786 if {[committer_ident
] eq
{}} {return 0}
2787 if {![lock_index merge
]} {return 0}
2789 # -- Our in memory state should match the repository.
2791 repository_state curType curHEAD curMERGE_HEAD
2792 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2793 info_popup
{Last scanned state does not match repository state.
2795 Another Git program has modified this repository
2796 since the last scan. A rescan must be performed
2797 before a merge can be performed.
2799 The rescan will be automatically started now.
2802 rescan
{set ui_status_value
{Ready.
}}
2806 foreach path
[array names file_states
] {
2807 switch
-glob -- [lindex
$file_states($path) 0] {
2809 continue; # and pray it works!
2812 error_popup
"You are in the middle of a conflicted merge.
2814 File [short_path $path] has merge conflicts.
2816 You must resolve them, add the file, and commit to
2817 complete the current merge. Only then can you
2818 begin another merge.
2824 error_popup
"You are in the middle of a change.
2826 File [short_path $path] is modified.
2828 You should complete the current commit before
2829 starting a merge. Doing so will help you abort
2830 a failed merge, should the need arise.
2841 proc visualize_local_merge
{w
} {
2843 foreach i
[$w.
source.l curselection
] {
2844 lappend revs
[$w.
source.l get
$i]
2846 if {$revs eq
{}} return
2847 lappend revs
--not HEAD
2851 proc start_local_merge_action
{w
} {
2852 global HEAD ui_status_value current_branch
2854 set cmd
[list git merge
]
2857 foreach i
[$w.
source.l curselection
] {
2858 set b
[$w.
source.l get
$i]
2866 } elseif
{$revcnt == 1} {
2868 } elseif
{$revcnt <= 15} {
2874 -title [wm title
$w] \
2876 -message "Too many branches selected.
2878 You have requested to merge $revcnt branches
2879 in an octopus merge. This exceeds Git's
2880 internal limit of 15 branches per merge.
2882 Please select fewer branches. To merge more
2883 than 15 branches, merge the branches in batches.
2888 set msg
"Merging $current_branch, [join $names {, }]"
2889 set ui_status_value
"$msg..."
2890 set cons
[new_console
"Merge" $msg]
2891 console_exec
$cons $cmd [list finish_merge
$revcnt]
2892 bind $w <Destroy
> {}
2896 proc finish_merge
{revcnt w ok
} {
2899 set msg
{Merge completed successfully.
}
2902 info_popup
"Octopus merge failed.
2904 Your merge of $revcnt branches has failed.
2906 There are file-level conflicts between the
2907 branches which must be resolved manually.
2909 The working directory will now be reset.
2911 You can attempt this merge again
2912 by merging only one branch at a time." $w
2914 set fd
[open
"| git read-tree --reset -u HEAD" r
]
2915 fconfigure
$fd -blocking 0 -translation binary
2916 fileevent
$fd readable
[list reset_hard_wait
$fd]
2917 set ui_status_value
{Aborting... please
wait...
}
2921 set msg
{Merge failed. Conflict resolution is required.
}
2924 rescan
[list
set ui_status_value
$msg]
2927 proc do_local_merge
{} {
2928 global current_branch
2930 if {![can_merge
]} return
2934 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2937 -text "Merge Into $current_branch" \
2939 pack
$w.header
-side top
-fill x
2942 button
$w.buttons.visualize
-text Visualize \
2944 -command [list visualize_local_merge
$w]
2945 pack
$w.buttons.visualize
-side left
2946 button
$w.buttons.create
-text Merge \
2948 -command [list start_local_merge_action
$w]
2949 pack
$w.buttons.create
-side right
2950 button
$w.buttons.cancel
-text {Cancel
} \
2952 -command [list destroy
$w]
2953 pack
$w.buttons.cancel
-side right
-padx 5
2954 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2956 labelframe
$w.
source \
2957 -text {Source Branches
} \
2959 listbox
$w.
source.l \
2962 -selectmode extended \
2963 -yscrollcommand [list
$w.
source.sby
set] \
2965 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2966 pack
$w.
source.sby
-side right
-fill y
2967 pack
$w.
source.l
-side left
-fill both
-expand 1
2968 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2970 set cmd
[list git for-each-ref
]
2971 lappend cmd
{--format=%(objectname
) %(*objectname
) %(refname
)}
2972 lappend cmd refs
/heads
2973 lappend cmd refs
/remotes
2974 lappend cmd refs
/tags
2975 set fr_fd
[open
"| $cmd" r
]
2976 fconfigure
$fr_fd -translation binary
2977 while {[gets
$fr_fd line
] > 0} {
2978 set line
[split $line { }]
2979 set sha1
([lindex
$line 0]) [lindex
$line 2]
2980 set sha1
([lindex
$line 1]) [lindex
$line 2]
2985 set fr_fd
[open
"| git rev-list --all --not HEAD"]
2986 while {[gets
$fr_fd line
] > 0} {
2987 if {[catch
{set ref
$sha1($line)}]} continue
2988 regsub ^refs
/(heads|remotes|tags
)/ $ref {} ref
2989 lappend to_show
$ref
2993 foreach ref
[lsort
-unique $to_show] {
2994 $w.
source.l insert end
$ref
2997 bind $w <Visibility
> "grab $w"
2998 bind $w <Key-Escape
> "unlock_index;destroy $w"
2999 bind $w <Destroy
> unlock_index
3000 wm title
$w "[appname] ([reponame]): Merge"
3004 proc do_reset_hard
{} {
3005 global HEAD commit_type file_states
3007 if {[string match amend
* $commit_type]} {
3008 info_popup
{Cannot abort
while amending.
3010 You must finish amending this commit.
3015 if {![lock_index abort
]} return
3017 if {[string match
*merge
* $commit_type]} {
3023 if {[ask_popup
"Abort $op?
3025 Aborting the current $op will cause
3026 *ALL* uncommitted changes to be lost.
3028 Continue with aborting the current $op?"] eq
{yes}} {
3029 set fd
[open
"| git read-tree --reset -u HEAD" r
]
3030 fconfigure
$fd -blocking 0 -translation binary
3031 fileevent
$fd readable
[list reset_hard_wait
$fd]
3032 set ui_status_value
{Aborting... please
wait...
}
3038 proc reset_hard_wait
{fd
} {
3046 $ui_comm delete
0.0 end
3047 $ui_comm edit modified false
3049 catch
{file delete
[gitdir MERGE_HEAD
]}
3050 catch
{file delete
[gitdir rr-cache MERGE_RR
]}
3051 catch
{file delete
[gitdir SQUASH_MSG
]}
3052 catch
{file delete
[gitdir MERGE_MSG
]}
3053 catch
{file delete
[gitdir GITGUI_MSG
]}
3055 rescan
{set ui_status_value
{Abort completed. Ready.
}}
3059 ######################################################################
3063 set next_browser_id
0
3065 proc new_browser
{commit
} {
3066 global next_browser_id cursor_ptr M1B
3067 global browser_commit browser_status browser_stack browser_path browser_busy
3069 if {[winfo ismapped .
]} {
3070 set w .browser
[incr next_browser_id
]
3077 set w_list
$w.list.l
3078 set browser_commit
($w_list) $commit
3079 set browser_status
($w_list) {Starting...
}
3080 set browser_stack
($w_list) {}
3081 set browser_path
($w_list) $browser_commit($w_list):
3082 set browser_busy
($w_list) 1
3084 label
$w.path
-textvariable browser_path
($w_list) \
3090 pack
$w.path
-anchor w
-side top
-fill x
3093 text
$w_list -background white
-borderwidth 0 \
3094 -cursor $cursor_ptr \
3099 -xscrollcommand [list
$w.list.sbx
set] \
3100 -yscrollcommand [list
$w.list.sby
set] \
3102 $w_list tag conf in_sel \
3103 -background [$w_list cget
-foreground] \
3104 -foreground [$w_list cget
-background]
3105 scrollbar
$w.list.sbx
-orient h
-command [list
$w_list xview
]
3106 scrollbar
$w.list.sby
-orient v
-command [list
$w_list yview
]
3107 pack
$w.list.sbx
-side bottom
-fill x
3108 pack
$w.list.sby
-side right
-fill y
3109 pack
$w_list -side left
-fill both
-expand 1
3110 pack
$w.list
-side top
-fill both
-expand 1
3112 label
$w.status
-textvariable browser_status
($w_list) \
3118 pack
$w.status
-anchor w
-side bottom
-fill x
3120 bind $w_list <Button-1
> "browser_click 0 $w_list @%x,%y;break"
3121 bind $w_list <Double-Button-1
> "browser_click 1 $w_list @%x,%y;break"
3122 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3123 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3124 bind $w_list <Up
> "browser_move -1 $w_list;break"
3125 bind $w_list <Down
> "browser_move 1 $w_list;break"
3126 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3127 bind $w_list <Return
> "browser_enter $w_list;break"
3128 bind $w_list <Prior
> "browser_page -1 $w_list;break"
3129 bind $w_list <Next
> "browser_page 1 $w_list;break"
3130 bind $w_list <Left
> break
3131 bind $w_list <Right
> break
3133 bind $tl <Visibility
> "focus $w"
3134 bind $tl <Destroy
> "
3135 array unset browser_buffer $w_list
3136 array unset browser_files $w_list
3137 array unset browser_status $w_list
3138 array unset browser_stack $w_list
3139 array unset browser_path $w_list
3140 array unset browser_commit $w_list
3141 array unset browser_busy $w_list
3143 wm title
$tl "[appname] ([reponame]): File Browser"
3144 ls_tree
$w_list $browser_commit($w_list) {}
3147 proc browser_move
{dir w
} {
3148 global browser_files browser_busy
3150 if {$browser_busy($w)} return
3151 set lno
[lindex
[split [$w index in_sel.first
] .
] 0]
3153 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3154 $w tag remove in_sel
0.0 end
3155 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3160 proc browser_page
{dir w
} {
3161 global browser_files browser_busy
3163 if {$browser_busy($w)} return
3164 $w yview scroll
$dir pages
3166 [lindex
[$w yview
] 0]
3167 * [llength
$browser_files($w)]
3169 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3170 $w tag remove in_sel
0.0 end
3171 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3176 proc browser_parent
{w
} {
3177 global browser_files browser_status browser_path
3178 global browser_stack browser_busy
3180 if {$browser_busy($w)} return
3181 set info
[lindex
$browser_files($w) 0]
3182 if {[lindex
$info 0] eq
{parent
}} {
3183 set parent
[lindex
$browser_stack($w) end-1
]
3184 set browser_stack
($w) [lrange
$browser_stack($w) 0 end-2
]
3185 if {$browser_stack($w) eq
{}} {
3186 regsub
{:.
*$
} $browser_path($w) {:} browser_path
($w)
3188 regsub
{/[^
/]+$
} $browser_path($w) {} browser_path
($w)
3190 set browser_status
($w) "Loading $browser_path($w)..."
3191 ls_tree
$w [lindex
$parent 0] [lindex
$parent 1]
3195 proc browser_enter
{w
} {
3196 global browser_files browser_status browser_path
3197 global browser_commit browser_stack browser_busy
3199 if {$browser_busy($w)} return
3200 set lno
[lindex
[split [$w index in_sel.first
] .
] 0]
3201 set info
[lindex
$browser_files($w) [expr {$lno - 1}]]
3203 switch
-- [lindex
$info 0] {
3208 set name
[lindex
$info 2]
3209 set escn
[escape_path
$name]
3210 set browser_status
($w) "Loading $escn..."
3211 append browser_path
($w) $escn
3212 ls_tree
$w [lindex
$info 1] $name
3215 set name
[lindex
$info 2]
3217 foreach n
$browser_stack($w) {
3218 append p
[lindex
$n 1]
3221 show_blame
$browser_commit($w) $p
3227 proc browser_click
{was_double_click w pos
} {
3228 global browser_files browser_busy
3230 if {$browser_busy($w)} return
3231 set lno
[lindex
[split [$w index
$pos] .
] 0]
3234 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3235 $w tag remove in_sel
0.0 end
3236 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3237 if {$was_double_click} {
3243 proc ls_tree
{w tree_id name
} {
3244 global browser_buffer browser_files browser_stack browser_busy
3246 set browser_buffer
($w) {}
3247 set browser_files
($w) {}
3248 set browser_busy
($w) 1
3250 $w conf
-state normal
3251 $w tag remove in_sel
0.0 end
3253 if {$browser_stack($w) ne
{}} {
3254 $w image create end \
3255 -align center
-padx 5 -pady 1 \
3258 $w insert end
{[Up To Parent
]}
3259 lappend browser_files
($w) parent
3261 lappend browser_stack
($w) [list
$tree_id $name]
3262 $w conf
-state disabled
3264 set cmd
[list git ls-tree
-z $tree_id]
3265 set fd
[open
"| $cmd" r
]
3266 fconfigure
$fd -blocking 0 -translation binary
-encoding binary
3267 fileevent
$fd readable
[list read_ls_tree
$fd $w]
3270 proc read_ls_tree
{fd w
} {
3271 global browser_buffer browser_files browser_status browser_busy
3273 if {![winfo exists
$w]} {
3278 append browser_buffer
($w) [read $fd]
3279 set pck
[split $browser_buffer($w) "\0"]
3280 set browser_buffer
($w) [lindex
$pck end
]
3282 set n
[llength
$browser_files($w)]
3283 $w conf
-state normal
3284 foreach p
[lrange
$pck 0 end-1
] {
3285 set info
[split $p "\t"]
3286 set path
[lindex
$info 1]
3287 set info
[split [lindex
$info 0] { }]
3288 set type [lindex
$info 1]
3289 set object
[lindex
$info 2]
3300 set image file_question
3304 if {$n > 0} {$w insert end
"\n"}
3305 $w image create end \
3306 -align center
-padx 5 -pady 1 \
3307 -name icon
[incr n
] \
3309 $w insert end
[escape_path
$path]
3310 lappend browser_files
($w) [list
$type $object $path]
3312 $w conf
-state disabled
3316 set browser_status
($w) Ready.
3317 set browser_busy
($w) 0
3318 array
unset browser_buffer
$w
3320 $w tag add in_sel
1.0 2.0
3326 proc show_blame
{commit path
} {
3327 global next_browser_id blame_status blame_data
3329 if {[winfo ismapped .
]} {
3330 set w .browser
[incr next_browser_id
]
3337 set blame_status
($w) {Loading current
file content...
}
3339 label
$w.path
-text "$commit:$path" \
3345 pack
$w.path
-side top
-fill x
3348 text
$w.out.loaded_t \
3349 -background white
-borderwidth 0 \
3355 $w.out.loaded_t tag conf annotated
-background grey
3357 text
$w.out.linenumber_t \
3358 -background white
-borderwidth 0 \
3364 $w.out.linenumber_t tag conf linenumber
-justify right
3366 text
$w.out.file_t \
3367 -background white
-borderwidth 0 \
3372 -xscrollcommand [list
$w.out.sbx
set] \
3375 scrollbar
$w.out.sbx
-orient h
-command [list
$w.out.file_t xview
]
3376 scrollbar
$w.out.sby
-orient v \
3377 -command [list scrollbar2many
[list \
3379 $w.out.linenumber_t \
3383 $w.out.linenumber_t \
3388 grid conf
$w.out.sbx
-column 2 -sticky we
3389 grid columnconfigure
$w.out
2 -weight 1
3390 grid rowconfigure
$w.out
0 -weight 1
3391 pack
$w.out
-fill both
-expand 1
3393 label
$w.status
-textvariable blame_status
($w) \
3399 pack
$w.status
-side bottom
-fill x
3403 -background white
-borderwidth 0 \
3408 -xscrollcommand [list
$w.cm.sbx
set] \
3409 -yscrollcommand [list
$w.cm.sby
set] \
3411 scrollbar
$w.cm.sbx
-orient h
-command [list
$w.cm.t xview
]
3412 scrollbar
$w.cm.sby
-orient v
-command [list
$w.cm.t yview
]
3413 pack
$w.cm.sby
-side right
-fill y
3414 pack
$w.cm.sbx
-side bottom
-fill x
3415 pack
$w.cm.t
-expand 1 -fill both
3416 pack
$w.cm
-side bottom
-fill x
3418 menu
$w.ctxm
-tearoff 0
3419 $w.ctxm add
command -label "Copy Commit" \
3421 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3425 $w.out.linenumber_t \
3427 $i tag conf in_sel \
3428 -background [$i cget
-foreground] \
3429 -foreground [$i cget
-background]
3430 $i conf
-yscrollcommand \
3431 [list many2scrollbar
[list \
3433 $w.out.linenumber_t \
3436 bind $i <Button-1
> "
3439 $w.out.linenumber_t \\
3448 tk_popup $w.ctxm %X %Y
3452 bind $w.cm.t
<Button-1
> "focus $w.cm.t"
3453 bind $tl <Visibility
> "focus $tl"
3454 bind $tl <Destroy
> "
3455 array unset blame_status {$w}
3456 array unset blame_data $w,*
3458 wm title
$tl "[appname] ([reponame]): File Viewer"
3460 set blame_data
($w,commit_count
) 0
3461 set blame_data
($w,commit_list
) {}
3462 set blame_data
($w,total_lines
) 0
3463 set blame_data
($w,blame_lines
) 0
3464 set blame_data
($w,highlight_commit
) {}
3465 set blame_data
($w,highlight_line
) -1
3467 set cmd
[list git cat-file blob
"$commit:$path"]
3468 set fd
[open
"| $cmd" r
]
3469 fconfigure
$fd -blocking 0 -translation lf
-encoding binary
3470 fileevent
$fd readable
[list read_blame_catfile \
3471 $fd $w $commit $path \
3472 $w.cm.t
$w.out.loaded_t
$w.out.linenumber_t
$w.out.file_t
]
3475 proc read_blame_catfile
{fd w commit path w_cmit w_load w_line w_file
} {
3476 global blame_status blame_data
3478 if {![winfo exists
$w_file]} {
3483 set n
$blame_data($w,total_lines
)
3484 $w_load conf
-state normal
3485 $w_line conf
-state normal
3486 $w_file conf
-state normal
3487 while {[gets
$fd line
] >= 0} {
3488 regsub
"\r\$" $line {} line
3490 $w_load insert end
"\n"
3491 $w_line insert end
"$n\n" linenumber
3492 $w_file insert end
"$line\n"
3494 $w_load conf
-state disabled
3495 $w_line conf
-state disabled
3496 $w_file conf
-state disabled
3497 set blame_data
($w,total_lines
) $n
3501 blame_incremental_status
$w
3502 set cmd
[list git blame
-M -C --incremental]
3503 lappend cmd
$commit -- $path
3504 set fd
[open
"| $cmd" r
]
3505 fconfigure
$fd -blocking 0 -translation lf
-encoding binary
3506 fileevent
$fd readable
[list read_blame_incremental
$fd $w \
3507 $w_load $w_cmit $w_line $w_file]
3511 proc read_blame_incremental
{fd w w_load w_cmit w_line w_file
} {
3512 global blame_status blame_data
3514 if {![winfo exists
$w_file]} {
3519 while {[gets
$fd line
] >= 0} {
3520 if {[regexp
{^
([a-z0-9
]{40}) (\d
+) (\d
+) (\d
+)$
} $line line \
3521 cmit original_line final_line line_count
]} {
3522 set blame_data
($w,commit
) $cmit
3523 set blame_data
($w,original_line
) $original_line
3524 set blame_data
($w,final_line
) $final_line
3525 set blame_data
($w,line_count
) $line_count
3527 if {[catch
{set g
$blame_data($w,$cmit,order
)}]} {
3528 $w_line tag conf g
$cmit
3529 $w_file tag conf g
$cmit
3530 $w_line tag raise in_sel
3531 $w_file tag raise in_sel
3532 $w_file tag raise sel
3533 set blame_data
($w,$cmit,order
) $blame_data($w,commit_count
)
3534 incr blame_data
($w,commit_count
)
3535 lappend blame_data
($w,commit_list
) $cmit
3537 } elseif
{[string match
{filename
*} $line]} {
3538 set file [string range
$line 9 end
]
3539 set n
$blame_data($w,line_count
)
3540 set lno
$blame_data($w,final_line
)
3541 set cmit
$blame_data($w,commit
)
3544 if {[catch
{set g g
$blame_data($w,line
$lno,commit
)}]} {
3545 $w_load tag add annotated
$lno.0 "$lno.0 lineend + 1c"
3547 $w_line tag remove g
$g $lno.0 "$lno.0 lineend + 1c"
3548 $w_file tag remove g
$g $lno.0 "$lno.0 lineend + 1c"
3551 set blame_data
($w,line
$lno,commit
) $cmit
3552 set blame_data
($w,line
$lno,file) $file
3553 $w_line tag add g
$cmit $lno.0 "$lno.0 lineend + 1c"
3554 $w_file tag add g
$cmit $lno.0 "$lno.0 lineend + 1c"
3556 if {$blame_data($w,highlight_line
) == -1} {
3557 if {[lindex
[$w_file yview
] 0] == 0} {
3559 blame_showcommit
$w $w_cmit $w_line $w_file $lno
3561 } elseif
{$blame_data($w,highlight_line
) == $lno} {
3562 blame_showcommit
$w $w_cmit $w_line $w_file $lno
3567 incr blame_data
($w,blame_lines
)
3570 set hc
$blame_data($w,highlight_commit
)
3572 && [expr {$blame_data($w,$hc,order
) + 1}]
3573 == $blame_data($w,$cmit,order
)} {
3574 blame_showcommit
$w $w_cmit $w_line $w_file \
3575 $blame_data($w,highlight_line
)
3577 } elseif
{[regexp
{^
([a-z-
]+) (.
*)$
} $line line header data
]} {
3578 set blame_data
($w,$blame_data($w,commit
),$header) $data
3584 set blame_status
($w) {Annotation complete.
}
3586 blame_incremental_status
$w
3590 proc blame_incremental_status
{w
} {
3591 global blame_status blame_data
3593 set blame_status
($w) [format \
3594 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3595 $blame_data($w,blame_lines
) \
3596 $blame_data($w,total_lines
) \
3597 [expr {100 * $blame_data($w,blame_lines
)
3598 / $blame_data($w,total_lines
)}]]
3601 proc blame_click
{w w_cmit w_line w_file cur_w pos
} {
3602 set lno
[lindex
[split [$cur_w index
$pos] .
] 0]
3603 if {$lno eq
{}} return
3605 $w_line tag remove in_sel
0.0 end
3606 $w_file tag remove in_sel
0.0 end
3607 $w_line tag add in_sel
$lno.0 "$lno.0 + 1 line"
3608 $w_file tag add in_sel
$lno.0 "$lno.0 + 1 line"
3610 blame_showcommit
$w $w_cmit $w_line $w_file $lno
3619 proc blame_showcommit
{w w_cmit w_line w_file lno
} {
3620 global blame_colors blame_data repo_config
3622 set cmit
$blame_data($w,highlight_commit
)
3624 set idx
$blame_data($w,$cmit,order
)
3626 foreach c
$blame_colors {
3627 set h
[lindex
$blame_data($w,commit_list
) [expr {$idx - 1 + $i}]]
3628 $w_line tag conf g
$h -background white
3629 $w_file tag conf g
$h -background white
3634 $w_cmit conf
-state normal
3635 $w_cmit delete
0.0 end
3636 if {[catch
{set cmit
$blame_data($w,line
$lno,commit
)}]} {
3638 $w_cmit insert end
"Loading annotation..."
3640 set idx
$blame_data($w,$cmit,order
)
3642 foreach c
$blame_colors {
3643 set h
[lindex
$blame_data($w,commit_list
) [expr {$idx - 1 + $i}]]
3644 $w_line tag conf g
$h -background $c
3645 $w_file tag conf g
$h -background $c
3649 if {[catch
{set msg
$blame_data($w,$cmit,message
)}]} {
3652 set fd
[open
"| git cat-file commit $cmit" r
]
3653 fconfigure
$fd -encoding binary
-translation lf
3654 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
3657 while {[gets
$fd line
] > 0} {
3658 if {[string match
{encoding
*} $line]} {
3659 set enc
[string tolower
[string range
$line 9 end
]]
3662 fconfigure
$fd -encoding $enc
3663 set msg
[string trim
[read $fd]]
3666 set blame_data
($w,$cmit,message
) $msg
3672 catch
{set author_name
$blame_data($w,$cmit,author
)}
3673 catch
{set author_email
$blame_data($w,$cmit,author-mail
)}
3674 catch
{set author_time
[clock format
$blame_data($w,$cmit,author-time
)]}
3676 set committer_name
{}
3677 set committer_email
{}
3678 set committer_time
{}
3679 catch
{set committer_name
$blame_data($w,$cmit,committer
)}
3680 catch
{set committer_email
$blame_data($w,$cmit,committer-mail
)}
3681 catch
{set committer_time
[clock format
$blame_data($w,$cmit,committer-time
)]}
3683 $w_cmit insert end
"commit $cmit\n"
3684 $w_cmit insert end
"Author: $author_name $author_email $author_time\n"
3685 $w_cmit insert end
"Committer: $committer_name $committer_email $committer_time\n"
3686 $w_cmit insert end
"Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3687 $w_cmit insert end
"\n"
3688 $w_cmit insert end
$msg
3690 $w_cmit conf
-state disabled
3692 set blame_data
($w,highlight_line
) $lno
3693 set blame_data
($w,highlight_commit
) $cmit
3696 proc blame_copycommit
{w i pos
} {
3698 set lno
[lindex
[split [$i index
$pos] .
] 0]
3699 if {![catch
{set commit
$blame_data($w,line
$lno,commit
)}]} {
3708 ######################################################################
3713 #define mask_width 14
3714 #define mask_height 15
3715 static unsigned char mask_bits
[] = {
3716 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3717 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3718 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3721 image create bitmap file_plain
-background white
-foreground black
-data {
3722 #define plain_width 14
3723 #define plain_height 15
3724 static unsigned char plain_bits
[] = {
3725 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3726 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3727 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3728 } -maskdata $filemask
3730 image create bitmap file_mod
-background white
-foreground blue
-data {
3731 #define mod_width 14
3732 #define mod_height 15
3733 static unsigned char mod_bits
[] = {
3734 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3735 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3736 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3737 } -maskdata $filemask
3739 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
3740 #define file_fulltick_width 14
3741 #define file_fulltick_height 15
3742 static unsigned char file_fulltick_bits
[] = {
3743 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3744 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3745 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3746 } -maskdata $filemask
3748 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
3749 #define parttick_width 14
3750 #define parttick_height 15
3751 static unsigned char parttick_bits
[] = {
3752 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3753 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3754 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3755 } -maskdata $filemask
3757 image create bitmap file_question
-background white
-foreground black
-data {
3758 #define file_question_width 14
3759 #define file_question_height 15
3760 static unsigned char file_question_bits
[] = {
3761 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3762 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3763 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3764 } -maskdata $filemask
3766 image create bitmap file_removed
-background white
-foreground red
-data {
3767 #define file_removed_width 14
3768 #define file_removed_height 15
3769 static unsigned char file_removed_bits
[] = {
3770 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3771 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3772 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3773 } -maskdata $filemask
3775 image create bitmap file_merge
-background white
-foreground blue
-data {
3776 #define file_merge_width 14
3777 #define file_merge_height 15
3778 static unsigned char file_merge_bits
[] = {
3779 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3780 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3781 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3782 } -maskdata $filemask
3785 #define file_width 18
3786 #define file_height 18
3787 static unsigned char file_bits
[] = {
3788 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3789 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3790 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3791 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3792 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3794 image create bitmap file_dir
-background white
-foreground blue \
3795 -data $file_dir_data -maskdata $file_dir_data
3798 set file_uplevel_data
{
3800 #define up_height 15
3801 static unsigned char up_bits
[] = {
3802 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3803 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3804 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3806 image create bitmap file_uplevel
-background white
-foreground red \
3807 -data $file_uplevel_data -maskdata $file_uplevel_data
3808 unset file_uplevel_data
3810 set ui_index .vpane.files.index.list
3811 set ui_workdir .vpane.files.workdir.list
3813 set all_icons
(_
$ui_index) file_plain
3814 set all_icons
(A
$ui_index) file_fulltick
3815 set all_icons
(M
$ui_index) file_fulltick
3816 set all_icons
(D
$ui_index) file_removed
3817 set all_icons
(U
$ui_index) file_merge
3819 set all_icons
(_
$ui_workdir) file_plain
3820 set all_icons
(M
$ui_workdir) file_mod
3821 set all_icons
(D
$ui_workdir) file_question
3822 set all_icons
(U
$ui_workdir) file_merge
3823 set all_icons
(O
$ui_workdir) file_plain
3825 set max_status_desc
0
3829 {_M
"Modified, not staged"}
3830 {M_
"Staged for commit"}
3831 {MM
"Portions staged for commit"}
3832 {MD
"Staged for commit, missing"}
3834 {_O
"Untracked, not staged"}
3835 {A_
"Staged for commit"}
3836 {AM
"Portions staged for commit"}
3837 {AD
"Staged for commit, missing"}
3840 {D_
"Staged for removal"}
3841 {DO
"Staged for removal, still present"}
3843 {U_
"Requires merge resolution"}
3844 {UU
"Requires merge resolution"}
3845 {UM
"Requires merge resolution"}
3846 {UD
"Requires merge resolution"}
3848 if {$max_status_desc < [string length
[lindex
$i 1]]} {
3849 set max_status_desc
[string length
[lindex
$i 1]]
3851 set all_descs
([lindex
$i 0]) [lindex
$i 1]
3855 ######################################################################
3859 proc bind_button3
{w cmd
} {
3860 bind $w <Any-Button-3
> $cmd
3862 bind $w <Control-Button-1
> $cmd
3866 proc scrollbar2many
{list mode args
} {
3867 foreach w
$list {eval $w $mode $args}
3870 proc many2scrollbar
{list mode sb top bottom
} {
3871 $sb set $top $bottom
3872 foreach w
$list {$w $mode moveto
$top}
3875 proc incr_font_size
{font
{amt
1}} {
3876 set sz
[font configure
$font -size]
3878 font configure
$font -size $sz
3879 font configure
${font}bold
-size $sz
3882 proc hook_failed_popup
{hook msg
} {
3887 label
$w.m.l1
-text "$hook hook failed:" \
3892 -background white
-borderwidth 1 \
3894 -width 80 -height 10 \
3896 -yscrollcommand [list
$w.m.sby
set]
3898 -text {You must correct the above errors before committing.
} \
3902 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3903 pack
$w.m.l1
-side top
-fill x
3904 pack
$w.m.l2
-side bottom
-fill x
3905 pack
$w.m.sby
-side right
-fill y
3906 pack
$w.m.t
-side left
-fill both
-expand 1
3907 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3909 $w.m.t insert
1.0 $msg
3910 $w.m.t conf
-state disabled
3912 button
$w.ok
-text OK \
3915 -command "destroy $w"
3916 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
3918 bind $w <Visibility
> "grab $w; focus $w"
3919 bind $w <Key-Return
> "destroy $w"
3920 wm title
$w "[appname] ([reponame]): error"
3924 set next_console_id
0
3926 proc new_console
{short_title long_title
} {
3927 global next_console_id console_data
3928 set w .console
[incr next_console_id
]
3929 set console_data
($w) [list
$short_title $long_title]
3930 return [console_init
$w]
3933 proc console_init
{w
} {
3934 global console_cr console_data M1B
3936 set console_cr
($w) 1.0
3939 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
3944 -background white
-borderwidth 1 \
3946 -width 80 -height 10 \
3949 -yscrollcommand [list
$w.m.sby
set]
3950 label
$w.m.s
-text {Working... please
wait...
} \
3954 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3955 pack
$w.m.l1
-side top
-fill x
3956 pack
$w.m.s
-side bottom
-fill x
3957 pack
$w.m.sby
-side right
-fill y
3958 pack
$w.m.t
-side left
-fill both
-expand 1
3959 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3961 menu
$w.ctxm
-tearoff 0
3962 $w.ctxm add
command -label "Copy" \
3964 -command "tk_textCopy $w.m.t"
3965 $w.ctxm add
command -label "Select All" \
3967 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3968 $w.ctxm add
command -label "Copy All" \
3971 $w.m.t tag add sel 0.0 end
3973 $w.m.t tag remove sel 0.0 end
3976 button
$w.ok
-text {Close
} \
3979 -command "destroy $w"
3980 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
3982 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
3983 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3984 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3985 bind $w <Visibility
> "focus $w"
3986 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3990 proc console_exec
{w cmd after
} {
3991 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3992 # But most users need that so we have to relogin. :-(
3995 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
3998 # -- Tcl won't let us redirect both stdout and stderr to
3999 # the same pipe. So pass it through cat...
4001 set cmd
[concat |
$cmd |
& cat]
4003 set fd_f
[open
$cmd r
]
4004 fconfigure
$fd_f -blocking 0 -translation binary
4005 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
4008 proc console_read
{w fd after
} {
4013 if {![winfo exists
$w]} {console_init
$w}
4014 $w.m.t conf
-state normal
4016 set n
[string length
$buf]
4018 set cr
[string first
"\r" $buf $c]
4019 set lf
[string first
"\n" $buf $c]
4020 if {$cr < 0} {set cr
[expr {$n + 1}]}
4021 if {$lf < 0} {set lf
[expr {$n + 1}]}
4024 $w.m.t insert end
[string range
$buf $c $lf]
4025 set console_cr
($w) [$w.m.t index
{end
-1c}]
4029 $w.m.t delete
$console_cr($w) end
4030 $w.m.t insert end
"\n"
4031 $w.m.t insert end
[string range
$buf $c $cr]
4036 $w.m.t conf
-state disabled
4040 fconfigure
$fd -blocking 1
4042 if {[catch
{close
$fd}]} {
4047 uplevel
#0 $after $w $ok
4050 fconfigure
$fd -blocking 0
4053 proc console_chain
{cmdlist w
{ok
1}} {
4055 if {[llength
$cmdlist] == 0} {
4060 set cmd
[lindex
$cmdlist 0]
4061 set cmdlist
[lrange
$cmdlist 1 end
]
4063 if {[lindex
$cmd 0] eq
{console_exec
}} {
4066 [list console_chain
$cmdlist]
4068 uplevel
#0 $cmd $cmdlist $w $ok
4075 proc console_done
{args
} {
4076 global console_cr console_data
4078 switch
-- [llength
$args] {
4080 set w
[lindex
$args 0]
4081 set ok
[lindex
$args 1]
4084 set w
[lindex
$args 1]
4085 set ok
[lindex
$args 2]
4088 error
"wrong number of args: console_done ?ignored? w ok"
4093 if {[winfo exists
$w]} {
4094 $w.m.s conf
-background green
-text {Success
}
4095 $w.ok conf
-state normal
4098 if {![winfo exists
$w]} {
4101 $w.m.s conf
-background red
-text {Error
: Command Failed
}
4102 $w.ok conf
-state normal
4105 array
unset console_cr
$w
4106 array
unset console_data
$w
4109 ######################################################################
4113 set starting_gitk_msg
{Starting gitk... please
wait...
}
4115 proc do_gitk
{revs
} {
4116 global env ui_status_value starting_gitk_msg
4118 # -- Always start gitk through whatever we were loaded with. This
4119 # lets us bypass using shell process on Windows systems.
4121 set cmd
[info nameofexecutable
]
4122 lappend cmd
[gitexec gitk
]
4128 if {[catch
{eval exec $cmd &} err
]} {
4129 error_popup
"Failed to start gitk:\n\n$err"
4131 set ui_status_value
$starting_gitk_msg
4133 if {$ui_status_value eq
$starting_gitk_msg} {
4134 set ui_status_value
{Ready.
}
4141 set fd
[open
"| git count-objects -v" r
]
4142 while {[gets
$fd line
] > 0} {
4143 if {[regexp
{^
([^
:]+): (\d
+)$
} $line _ name value
]} {
4144 set stats
($name) $value
4150 foreach p
[glob
-directory [gitdir objects pack
] \
4153 incr packed_sz
[file size
$p]
4155 if {$packed_sz > 0} {
4156 set stats
(size-pack
) [expr {$packed_sz / 1024}]
4161 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4163 label
$w.header
-text {Database Statistics
} \
4165 pack
$w.header
-side top
-fill x
4167 frame
$w.buttons
-border 1
4168 button
$w.buttons.close
-text Close \
4170 -command [list destroy
$w]
4171 button
$w.buttons.gc
-text {Compress Database
} \
4173 -command "destroy $w;do_gc"
4174 pack
$w.buttons.close
-side right
4175 pack
$w.buttons.gc
-side left
4176 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4178 frame
$w.stat
-borderwidth 1 -relief solid
4180 {count
{Number of loose objects
}}
4181 {size
{Disk space used by loose objects
} { KiB
}}
4182 {in-pack
{Number of packed objects
}}
4183 {packs
{Number of packs
}}
4184 {size-pack
{Disk space used by packed objects
} { KiB
}}
4185 {prune-packable
{Packed objects waiting
for pruning
}}
4186 {garbage
{Garbage files
}}
4188 set name
[lindex
$s 0]
4189 set label
[lindex
$s 1]
4190 if {[catch
{set value
$stats($name)}]} continue
4191 if {[llength
$s] > 2} {
4192 set value
"$value[lindex $s 2]"
4195 label
$w.stat.l_
$name -text "$label:" -anchor w
-font font_ui
4196 label
$w.stat.v_
$name -text $value -anchor w
-font font_ui
4197 grid
$w.stat.l_
$name $w.stat.v_
$name -sticky we
-padx {0 5}
4199 pack
$w.stat
-pady 10 -padx 10
4201 bind $w <Visibility
> "grab $w; focus $w"
4202 bind $w <Key-Escape
> [list destroy
$w]
4203 bind $w <Key-Return
> [list destroy
$w]
4204 wm title
$w "[appname] ([reponame]): Database Statistics"
4209 set w
[new_console
{gc
} {Compressing the object database
}]
4211 {console_exec
{git pack-refs
--prune}}
4212 {console_exec
{git reflog expire
--all}}
4213 {console_exec
{git repack
-a -d -l}}
4214 {console_exec
{git rerere gc
}}
4218 proc do_fsck_objects
{} {
4219 set w
[new_console
{fsck-objects
} \
4220 {Verifying the object database with fsck-objects
}]
4221 set cmd
[list git fsck-objects
]
4224 lappend cmd
--strict
4225 console_exec
$w $cmd console_done
4231 global ui_comm is_quitting repo_config commit_type
4233 if {$is_quitting} return
4236 if {[winfo exists
$ui_comm]} {
4237 # -- Stash our current commit buffer.
4239 set save
[gitdir GITGUI_MSG
]
4240 set msg
[string trim
[$ui_comm get
0.0 end
]]
4241 regsub
-all -line {[ \r\t]+$
} $msg {} msg
4242 if {(![string match amend
* $commit_type]
4243 ||
[$ui_comm edit modified
])
4246 set fd
[open
$save w
]
4247 puts
-nonewline $fd $msg
4251 catch
{file delete
$save}
4254 # -- Stash our current window geometry into this repository.
4256 set cfg_geometry
[list
]
4257 lappend cfg_geometry
[wm geometry .
]
4258 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
4259 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
4260 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
4263 if {$cfg_geometry ne
$rc_geometry} {
4264 catch
{git config gui.geometry
$cfg_geometry}
4272 rescan
{set ui_status_value
{Ready.
}}
4275 proc unstage_helper
{txt paths
} {
4276 global file_states current_diff_path
4278 if {![lock_index begin-update
]} return
4282 foreach path
$paths {
4283 switch
-glob -- [lindex
$file_states($path) 0] {
4287 lappend pathList
$path
4288 if {$path eq
$current_diff_path} {
4289 set after
{reshow_diff
;}
4294 if {$pathList eq
{}} {
4300 [concat
$after {set ui_status_value
{Ready.
}}]
4304 proc do_unstage_selection
{} {
4305 global current_diff_path selected_paths
4307 if {[array size selected_paths
] > 0} {
4309 {Unstaging selected files from commit
} \
4310 [array names selected_paths
]
4311 } elseif
{$current_diff_path ne
{}} {
4313 "Unstaging [short_path $current_diff_path] from commit" \
4314 [list
$current_diff_path]
4318 proc add_helper
{txt paths
} {
4319 global file_states current_diff_path
4321 if {![lock_index begin-update
]} return
4325 foreach path
$paths {
4326 switch
-glob -- [lindex
$file_states($path) 0] {
4331 lappend pathList
$path
4332 if {$path eq
$current_diff_path} {
4333 set after
{reshow_diff
;}
4338 if {$pathList eq
{}} {
4344 [concat
$after {set ui_status_value
{Ready to commit.
}}]
4348 proc do_add_selection
{} {
4349 global current_diff_path selected_paths
4351 if {[array size selected_paths
] > 0} {
4353 {Adding selected files
} \
4354 [array names selected_paths
]
4355 } elseif
{$current_diff_path ne
{}} {
4357 "Adding [short_path $current_diff_path]" \
4358 [list
$current_diff_path]
4362 proc do_add_all
{} {
4366 foreach path
[array names file_states
] {
4367 switch
-glob -- [lindex
$file_states($path) 0] {
4370 ?D
{lappend paths
$path}
4373 add_helper
{Adding all changed files
} $paths
4376 proc revert_helper
{txt paths
} {
4377 global file_states current_diff_path
4379 if {![lock_index begin-update
]} return
4383 foreach path
$paths {
4384 switch
-glob -- [lindex
$file_states($path) 0] {
4388 lappend pathList
$path
4389 if {$path eq
$current_diff_path} {
4390 set after
{reshow_diff
;}
4396 set n
[llength
$pathList]
4400 } elseif
{$n == 1} {
4401 set s
"[short_path [lindex $pathList]]"
4403 set s
"these $n files"
4406 set reply
[tk_dialog \
4408 "[appname] ([reponame])" \
4409 "Revert changes in $s?
4411 Any unadded changes will be permanently lost by the revert." \
4421 [concat
$after {set ui_status_value
{Ready.
}}]
4427 proc do_revert_selection
{} {
4428 global current_diff_path selected_paths
4430 if {[array size selected_paths
] > 0} {
4432 {Reverting selected files
} \
4433 [array names selected_paths
]
4434 } elseif
{$current_diff_path ne
{}} {
4436 "Reverting [short_path $current_diff_path]" \
4437 [list
$current_diff_path]
4441 proc do_signoff
{} {
4444 set me
[committer_ident
]
4445 if {$me eq
{}} return
4447 set sob
"Signed-off-by: $me"
4448 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
4449 if {$last ne
$sob} {
4450 $ui_comm edit separator
4452 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
4453 $ui_comm insert end
"\n"
4455 $ui_comm insert end
"\n$sob"
4456 $ui_comm edit separator
4461 proc do_select_commit_type
{} {
4462 global commit_type selected_commit_type
4464 if {$selected_commit_type eq
{new
}
4465 && [string match amend
* $commit_type]} {
4467 } elseif
{$selected_commit_type eq
{amend
}
4468 && ![string match amend
* $commit_type]} {
4471 # The amend request was rejected...
4473 if {![string match amend
* $commit_type]} {
4474 set selected_commit_type new
4483 proc do_credits
{} {
4484 global gitgui_credits
4486 set w .credits_dialog
4489 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4491 label
$w.header
-text {git-gui Contributors
} -font font_uibold
4492 pack
$w.header
-side top
-fill x
4495 button
$w.buttons.close
-text {Close
} \
4497 -command [list destroy
$w]
4498 pack
$w.buttons.close
-side right
4499 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4503 -background [$w.header cget
-background] \
4504 -yscrollcommand [list
$w.credits.sby
set] \
4512 scrollbar
$w.credits.sby
-command [list
$w.credits.t yview
]
4513 pack
$w.credits.sby
-side right
-fill y
4514 pack
$w.credits.t
-fill both
-expand 1
4515 pack
$w.credits
-side top
-fill both
-expand 1 -padx 5 -pady 5
4518 -text "All portions are copyrighted by their respective authors
4519 and are distributed under the GNU General Public License." \
4526 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
4528 $w.credits.t insert end
"[string trim $gitgui_credits]\n"
4529 $w.credits.t conf
-state disabled
4530 $w.credits.t see
1.0
4532 bind $w <Visibility
> "grab $w; focus $w"
4533 bind $w <Key-Escape
> [list destroy
$w]
4534 wm title
$w [$w.header cget
-text]
4539 global appvers copyright
4540 global tcl_patchLevel tk_patchLevel
4544 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4546 label
$w.header
-text "About [appname]" \
4548 pack
$w.header
-side top
-fill x
4551 button
$w.buttons.close
-text {Close
} \
4553 -command [list destroy
$w]
4554 button
$w.buttons.credits
-text {Contributors
} \
4557 pack
$w.buttons.credits
-side left
4558 pack
$w.buttons.close
-side right
4559 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4562 -text "git-gui - a graphical user interface for Git.
4570 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
4573 append v
"git-gui version $appvers\n"
4574 append v
"[git version]\n"
4576 if {$tcl_patchLevel eq
$tk_patchLevel} {
4577 append v
"Tcl/Tk version $tcl_patchLevel"
4579 append v
"Tcl version $tcl_patchLevel"
4580 append v
", Tk version $tk_patchLevel"
4591 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
4593 menu
$w.ctxm
-tearoff 0
4594 $w.ctxm add
command \
4599 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4602 bind $w <Visibility
> "grab $w; focus $w"
4603 bind $w <Key-Escape
> "destroy $w"
4604 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4605 wm title
$w "About [appname]"
4609 proc do_options
{} {
4610 global repo_config global_config font_descs
4611 global repo_config_new global_config_new
4613 array
unset repo_config_new
4614 array
unset global_config_new
4615 foreach name
[array names repo_config
] {
4616 set repo_config_new
($name) $repo_config($name)
4619 foreach name
[array names repo_config
] {
4621 gui.diffcontext
{continue}
4623 set repo_config_new
($name) $repo_config($name)
4625 foreach name
[array names global_config
] {
4626 set global_config_new
($name) $global_config($name)
4629 set w .options_editor
4631 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4633 label
$w.header
-text "Options" \
4635 pack
$w.header
-side top
-fill x
4638 button
$w.buttons.restore
-text {Restore Defaults
} \
4640 -command do_restore_defaults
4641 pack
$w.buttons.restore
-side left
4642 button
$w.buttons.save
-text Save \
4644 -command [list do_save_config
$w]
4645 pack
$w.buttons.save
-side right
4646 button
$w.buttons.cancel
-text {Cancel
} \
4648 -command [list destroy
$w]
4649 pack
$w.buttons.cancel
-side right
-padx 5
4650 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4652 labelframe
$w.repo
-text "[reponame] Repository" \
4654 labelframe
$w.global
-text {Global
(All Repositories
)} \
4656 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
4657 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
4661 {t user.name
{User Name
}}
4662 {t user.email
{Email Address
}}
4664 {b merge.summary
{Summarize Merge Commits
}}
4665 {i-1.
.5 merge.verbosity
{Merge Verbosity
}}
4667 {b gui.trustmtime
{Trust File Modification Timestamps
}}
4668 {i-1.
.99 gui.diffcontext
{Number of Diff Context Lines
}}
4669 {t gui.newbranchtemplate
{New Branch Name Template
}}
4671 set type [lindex
$option 0]
4672 set name
[lindex
$option 1]
4673 set text
[lindex
$option 2]
4675 foreach f
{repo global
} {
4676 switch
-glob -- $type {
4678 checkbutton
$w.
$f.
$optid -text $text \
4679 -variable ${f}_config_new
($name) \
4683 pack
$w.
$f.
$optid -side top
-anchor w
4686 regexp
-- {-(\d
+)\.\.
(\d
+)$
} $type _junk min max
4688 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
4689 pack
$w.
$f.
$optid.l
-side left
-anchor w
-fill x
4690 spinbox
$w.
$f.
$optid.v \
4691 -textvariable ${f}_config_new
($name) \
4695 -width [expr {1 + [string length
$max]}] \
4697 bind $w.
$f.
$optid.v
<FocusIn
> {%W selection range
0 end
}
4698 pack
$w.
$f.
$optid.v
-side right
-anchor e
-padx 5
4699 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
4703 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
4704 entry
$w.
$f.
$optid.v \
4708 -textvariable ${f}_config_new
($name) \
4710 pack
$w.
$f.
$optid.l
-side left
-anchor w
4711 pack
$w.
$f.
$optid.v
-side left
-anchor w \
4714 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
4720 set all_fonts
[lsort
[font families
]]
4721 foreach option
$font_descs {
4722 set name
[lindex
$option 0]
4723 set font
[lindex
$option 1]
4724 set text
[lindex
$option 2]
4726 set global_config_new
(gui.
$font^^family
) \
4727 [font configure
$font -family]
4728 set global_config_new
(gui.
$font^^size
) \
4729 [font configure
$font -size]
4731 frame
$w.global.
$name
4732 label
$w.global.
$name.l
-text "$text:" -font font_ui
4733 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
4734 eval tk_optionMenu
$w.global.
$name.family \
4735 global_config_new
(gui.
$font^^family
) \
4737 spinbox
$w.global.
$name.size \
4738 -textvariable global_config_new
(gui.
$font^^size
) \
4739 -from 2 -to 80 -increment 1 \
4742 bind $w.global.
$name.size
<FocusIn
> {%W selection range
0 end
}
4743 pack
$w.global.
$name.size
-side right
-anchor e
4744 pack
$w.global.
$name.family
-side right
-anchor e
4745 pack
$w.global.
$name -side top
-anchor w
-fill x
4748 bind $w <Visibility
> "grab $w; focus $w"
4749 bind $w <Key-Escape
> "destroy $w"
4750 wm title
$w "[appname] ([reponame]): Options"
4754 proc do_restore_defaults
{} {
4755 global font_descs default_config repo_config
4756 global repo_config_new global_config_new
4758 foreach name
[array names default_config
] {
4759 set repo_config_new
($name) $default_config($name)
4760 set global_config_new
($name) $default_config($name)
4763 foreach option
$font_descs {
4764 set name
[lindex
$option 0]
4765 set repo_config
(gui.
$name) $default_config(gui.
$name)
4769 foreach option
$font_descs {
4770 set name
[lindex
$option 0]
4771 set font
[lindex
$option 1]
4772 set global_config_new
(gui.
$font^^family
) \
4773 [font configure
$font -family]
4774 set global_config_new
(gui.
$font^^size
) \
4775 [font configure
$font -size]
4779 proc do_save_config
{w
} {
4780 if {[catch
{save_config
} err
]} {
4781 error_popup
"Failed to completely save options:\n\n$err"
4787 proc do_windows_shortcut
{} {
4790 set fn
[tk_getSaveFile \
4792 -title "[appname] ([reponame]): Create Desktop Icon" \
4793 -initialfile "Git [reponame].bat"]
4797 puts
$fd "@ECHO Entering [reponame]"
4798 puts
$fd "@ECHO Starting git-gui... please wait..."
4799 puts
$fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4800 puts
$fd "@SET GIT_DIR=[file normalize [gitdir]]"
4801 puts
-nonewline $fd "@\"[info nameofexecutable]\""
4802 puts
$fd " \"[file normalize $argv0]\""
4805 error_popup
"Cannot write script:\n\n$err"
4810 proc do_cygwin_shortcut
{} {
4814 set desktop
[exec cygpath \
4822 set fn
[tk_getSaveFile \
4824 -title "[appname] ([reponame]): Create Desktop Icon" \
4825 -initialdir $desktop \
4826 -initialfile "Git [reponame].bat"]
4830 set sh
[exec cygpath \
4834 set me
[exec cygpath \
4838 set gd
[exec cygpath \
4842 set gw
[exec cygpath \
4845 [file dirname [gitdir
]]]
4846 regsub
-all ' $me "'\\''" me
4847 regsub -all ' $gd "'\\''" gd
4848 puts $fd "@ECHO Entering $gw"
4849 puts $fd "@ECHO Starting git-gui... please wait..."
4850 puts -nonewline $fd "@\"$sh\" --login -c \""
4851 puts -nonewline $fd "GIT_DIR='$gd'"
4852 puts -nonewline $fd " '$me'"
4856 error_popup "Cannot write script:\n\n$err"
4861 proc do_macosx_app {} {
4864 set fn [tk_getSaveFile \
4866 -title "[appname] ([reponame]): Create Desktop Icon" \
4867 -initialdir [file join $env(HOME) Desktop] \
4868 -initialfile "Git [reponame].app"]
4871 set Contents [file join $fn Contents]
4872 set MacOS [file join $Contents MacOS]
4873 set exe [file join $MacOS git-gui]
4877 set fd [open [file join $Contents Info.plist] w]
4878 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4879 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4880 <plist version="1.0">
4882 <key>CFBundleDevelopmentRegion</key>
4883 <string>English</string>
4884 <key>CFBundleExecutable</key>
4885 <string>git-gui</string>
4886 <key>CFBundleIdentifier</key>
4887 <string>org.spearce.git-gui</string>
4888 <key>CFBundleInfoDictionaryVersion</key>
4889 <string>6.0</string>
4890 <key>CFBundlePackageType</key>
4891 <string>APPL</string>
4892 <key>CFBundleSignature</key>
4893 <string>????</string>
4894 <key>CFBundleVersion</key>
4895 <string>1.0</string>
4896 <key>NSPrincipalClass</key>
4897 <string>NSApplication</string>
4902 set fd [open $exe w]
4903 set gd [file normalize [gitdir]]
4904 set ep [file normalize [gitexec]]
4905 regsub -all ' $gd "'\\''" gd
4906 regsub
-all ' $ep "'\\''" ep
4907 puts $fd "#!/bin/sh"
4908 foreach name
[array names env
] {
4909 if {[string match GIT_
* $name]} {
4910 regsub
-all ' $env($name) "'\\''" v
4911 puts $fd "export $name='$v'"
4914 puts $fd "export PATH
='$ep':\
$PATH"
4915 puts $fd "export GIT_DIR
='$gd'"
4916 puts $fd "exec [file normalize
$argv0]"
4919 file attributes $exe -permissions u+x,g+x,o+x
4921 error_popup "Cannot
write icon
:\n\n$err"
4926 proc toggle_or_diff {w x y} {
4927 global file_states file_lists current_diff_path ui_index ui_workdir
4928 global last_clicked selected_paths
4930 set pos [split [$w index @$x,$y] .]
4931 set lno [lindex $pos 0]
4932 set col [lindex $pos 1]
4933 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4939 set last_clicked [list $w $lno]
4940 array unset selected_paths
4941 $ui_index tag remove in_sel 0.0 end
4942 $ui_workdir tag remove in_sel 0.0 end
4945 if {$current_diff_path eq $path} {
4946 set after {reshow_diff;}
4950 if {$w eq $ui_index} {
4952 "Unstaging
[short_path
$path] from commit
" \
4954 [concat $after {set ui_status_value {Ready.}}]
4955 } elseif {$w eq $ui_workdir} {
4957 "Adding
[short_path
$path]" \
4959 [concat $after {set ui_status_value {Ready.}}]
4962 show_diff $path $w $lno
4966 proc add_one_to_selection {w x y} {
4967 global file_lists last_clicked selected_paths
4969 set lno [lindex [split [$w index @$x,$y] .] 0]
4970 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4976 if {$last_clicked ne {}
4977 && [lindex $last_clicked 0] ne $w} {
4978 array unset selected_paths
4979 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4982 set last_clicked [list $w $lno]
4983 if {[catch {set in_sel $selected_paths($path)}]} {
4987 unset selected_paths($path)
4988 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4990 set selected_paths($path) 1
4991 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4995 proc add_range_to_selection {w x y} {
4996 global file_lists last_clicked selected_paths
4998 if {[lindex $last_clicked 0] ne $w} {
4999 toggle_or_diff $w $x $y
5003 set lno [lindex [split [$w index @$x,$y] .] 0]
5004 set lc [lindex $last_clicked 1]
5013 foreach path [lrange $file_lists($w) \
5014 [expr {$begin - 1}] \
5015 [expr {$end - 1}]] {
5016 set selected_paths($path) 1
5018 $w tag add in_sel $begin.0 [expr {$end + 1}].0
5021 ######################################################################
5025 set cursor_ptr arrow
5026 font create font_diff -family Courier -size 10
5030 eval font configure font_ui [font actual [.dummy cget -font]]
5034 font create font_uibold
5035 font create font_diffbold
5040 } elseif {[is_MacOSX]} {
5048 proc apply_config {} {
5049 global repo_config font_descs
5051 foreach option $font_descs {
5052 set name [lindex $option 0]
5053 set font [lindex $option 1]
5055 foreach {cn cv} $repo_config(gui.$name) {
5056 font configure $font $cn $cv
5059 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
5061 foreach {cn cv} [font configure $font] {
5062 font configure ${font}bold $cn $cv
5064 font configure ${font}bold -weight bold
5068 set default_config(merge.summary) false
5069 set default_config(merge.verbosity) 2
5070 set default_config(user.name) {}
5071 set default_config(user.email) {}
5073 set default_config(gui.trustmtime) false
5074 set default_config(gui.diffcontext) 5
5075 set default_config(gui.newbranchtemplate) {}
5076 set default_config(gui.fontui) [font configure font_ui]
5077 set default_config(gui.fontdiff) [font configure font_diff]
5079 {fontui font_ui {Main Font}}
5080 {fontdiff font_diff {Diff/Console Font}}
5085 ######################################################################
5087 ## feature option selection
5089 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
5094 if {$subcommand eq {gui.sh}} {
5097 if {$subcommand eq {gui} && [llength $argv] > 0} {
5098 set subcommand [lindex $argv 0]
5099 set argv [lrange $argv 1 end]
5102 enable_option multicommit
5103 enable_option branch
5104 enable_option transport
5106 switch -- $subcommand {
5111 disable_option multicommit
5112 disable_option branch
5113 disable_option transport
5116 enable_option singlecommit
5118 disable_option multicommit
5119 disable_option branch
5120 disable_option transport
5124 ######################################################################
5132 menu .mbar -tearoff 0
5133 .mbar add cascade -label Repository -menu .mbar.repository
5134 .mbar add cascade -label Edit -menu .mbar.edit
5135 if {[is_enabled branch]} {
5136 .mbar add cascade -label Branch -menu .mbar.branch
5138 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5139 .mbar add cascade -label Commit -menu .mbar.commit
5141 if {[is_enabled transport]} {
5142 .mbar add cascade -label Merge -menu .mbar.merge
5143 .mbar add cascade -label Fetch -menu .mbar.fetch
5144 .mbar add cascade -label Push -menu .mbar.push
5146 . configure -menu .mbar
5148 # -- Repository Menu
5150 menu .mbar.repository
5152 .mbar.repository add command \
5153 -label {Browse Current Branch} \
5154 -command {new_browser $current_branch} \
5156 trace add variable current_branch write ".mbar.repository entryconf
[.mbar.repository index last
] -label \"Browse \
$current_branch\" ;#"
5157 .mbar.repository add separator
5159 .mbar.repository add
command \
5160 -label {Visualize Current Branch
} \
5161 -command {do_gitk
$current_branch} \
5163 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5164 .mbar.repository add
command \
5165 -label {Visualize All Branches
} \
5166 -command {do_gitk
--all} \
5168 .mbar.repository add separator
5170 if {[is_enabled multicommit
]} {
5171 .mbar.repository add
command -label {Database Statistics
} \
5175 .mbar.repository add
command -label {Compress Database
} \
5179 .mbar.repository add
command -label {Verify Database
} \
5180 -command do_fsck_objects \
5183 .mbar.repository add separator
5186 .mbar.repository add
command \
5187 -label {Create Desktop Icon
} \
5188 -command do_cygwin_shortcut \
5190 } elseif
{[is_Windows
]} {
5191 .mbar.repository add
command \
5192 -label {Create Desktop Icon
} \
5193 -command do_windows_shortcut \
5195 } elseif
{[is_MacOSX
]} {
5196 .mbar.repository add
command \
5197 -label {Create Desktop Icon
} \
5198 -command do_macosx_app \
5203 .mbar.repository add
command -label Quit \
5205 -accelerator $M1T-Q \
5211 .mbar.edit add
command -label Undo \
5212 -command {catch
{[focus
] edit undo
}} \
5213 -accelerator $M1T-Z \
5215 .mbar.edit add
command -label Redo \
5216 -command {catch
{[focus
] edit redo
}} \
5217 -accelerator $M1T-Y \
5219 .mbar.edit add separator
5220 .mbar.edit add
command -label Cut \
5221 -command {catch
{tk_textCut
[focus
]}} \
5222 -accelerator $M1T-X \
5224 .mbar.edit add
command -label Copy \
5225 -command {catch
{tk_textCopy
[focus
]}} \
5226 -accelerator $M1T-C \
5228 .mbar.edit add
command -label Paste \
5229 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
5230 -accelerator $M1T-V \
5232 .mbar.edit add
command -label Delete \
5233 -command {catch
{[focus
] delete sel.first sel.last
}} \
5236 .mbar.edit add separator
5237 .mbar.edit add
command -label {Select All
} \
5238 -command {catch
{[focus
] tag add sel
0.0 end
}} \
5239 -accelerator $M1T-A \
5244 if {[is_enabled branch
]} {
5247 .mbar.branch add
command -label {Create...
} \
5248 -command do_create_branch \
5249 -accelerator $M1T-N \
5251 lappend disable_on_lock
[list .mbar.branch entryconf \
5252 [.mbar.branch index last
] -state]
5254 .mbar.branch add
command -label {Delete...
} \
5255 -command do_delete_branch \
5257 lappend disable_on_lock
[list .mbar.branch entryconf \
5258 [.mbar.branch index last
] -state]
5263 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
5266 .mbar.commit add radiobutton \
5267 -label {New Commit
} \
5268 -command do_select_commit_type \
5269 -variable selected_commit_type \
5272 lappend disable_on_lock \
5273 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5275 .mbar.commit add radiobutton \
5276 -label {Amend Last Commit
} \
5277 -command do_select_commit_type \
5278 -variable selected_commit_type \
5281 lappend disable_on_lock \
5282 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5284 .mbar.commit add separator
5286 .mbar.commit add
command -label Rescan \
5287 -command do_rescan \
5290 lappend disable_on_lock \
5291 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5293 .mbar.commit add
command -label {Add To Commit
} \
5294 -command do_add_selection \
5296 lappend disable_on_lock \
5297 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5299 .mbar.commit add
command -label {Add Existing To Commit
} \
5300 -command do_add_all \
5301 -accelerator $M1T-I \
5303 lappend disable_on_lock \
5304 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5306 .mbar.commit add
command -label {Unstage From Commit
} \
5307 -command do_unstage_selection \
5309 lappend disable_on_lock \
5310 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5312 .mbar.commit add
command -label {Revert Changes
} \
5313 -command do_revert_selection \
5315 lappend disable_on_lock \
5316 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5318 .mbar.commit add separator
5320 .mbar.commit add
command -label {Sign Off
} \
5321 -command do_signoff \
5322 -accelerator $M1T-S \
5325 .mbar.commit add
command -label Commit \
5326 -command do_commit \
5327 -accelerator $M1T-Return \
5329 lappend disable_on_lock \
5330 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5334 # -- Apple Menu (Mac OS X only)
5336 .mbar add cascade
-label Apple
-menu .mbar.apple
5339 .mbar.apple add
command -label "About [appname]" \
5342 .mbar.apple add
command -label "Options..." \
5343 -command do_options \
5348 .mbar.edit add separator
5349 .mbar.edit add
command -label {Options...
} \
5350 -command do_options \
5355 if {[file exists
/usr
/local
/miga
/lib
/gui-miga
]
5356 && [file exists .pvcsrc
]} {
5358 global ui_status_value
5359 if {![lock_index update
]} return
5360 set cmd
[list sh
--login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5361 set miga_fd
[open
"|$cmd" r
]
5362 fconfigure
$miga_fd -blocking 0
5363 fileevent
$miga_fd readable
[list miga_done
$miga_fd]
5364 set ui_status_value
{Running miga...
}
5366 proc miga_done
{fd
} {
5371 rescan
[list
set ui_status_value
{Ready.
}]
5374 .mbar add cascade
-label Tools
-menu .mbar.tools
5376 .mbar.tools add
command -label "Migrate" \
5379 lappend disable_on_lock \
5380 [list .mbar.tools entryconf
[.mbar.tools index last
] -state]
5386 .mbar add cascade
-label Help
-menu .mbar.
help
5390 .mbar.
help add
command -label "About [appname]" \
5396 catch
{set browser
$repo_config(instaweb.browser
)}
5397 set doc_path
[file dirname [gitexec
]]
5398 set doc_path
[file join $doc_path Documentation index.html
]
5401 set doc_path
[exec cygpath
--mixed $doc_path]
5404 if {$browser eq
{}} {
5407 } elseif
{[is_Cygwin
]} {
5408 set program_files
[file dirname [exec cygpath
--windir]]
5409 set program_files
[file join $program_files {Program Files
}]
5410 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
5411 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
5412 if {[file exists
$firefox]} {
5413 set browser
$firefox
5414 } elseif
{[file exists
$ie]} {
5417 unset program_files firefox ie
5421 if {[file isfile
$doc_path]} {
5422 set doc_url
"file:$doc_path"
5424 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
5427 if {$browser ne
{}} {
5428 .mbar.
help add
command -label {Online Documentation
} \
5429 -command [list
exec $browser $doc_url &] \
5432 unset browser doc_path doc_url
5434 # -- Standard bindings
5436 bind .
<Destroy
> do_quit
5437 bind all
<$M1B-Key-q> do_quit
5438 bind all
<$M1B-Key-Q> do_quit
5439 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
5440 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
5442 # -- Not a normal commit type invocation? Do that instead!
5444 switch
-- $subcommand {
5447 puts
"git-gui version $appvers"
5451 if {[llength
$argv] != 1} {
5452 puts stderr
"usage: $argv0 browser commit"
5455 set current_branch
[lindex
$argv 0]
5456 new_browser
$current_branch
5460 if {[llength
$argv] != 2} {
5461 puts stderr
"usage: $argv0 blame commit path"
5464 set current_branch
[lindex
$argv 0]
5465 show_blame
$current_branch [lindex
$argv 1]
5470 if {[llength
$argv] != 0} {
5471 puts
-nonewline stderr
"usage: $argv0"
5472 if {$subcommand ne
{gui
} && [appname
] ne
"git-$subcommand"} {
5473 puts
-nonewline stderr
" $subcommand"
5478 # fall through to setup UI for commits
5481 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
5492 -text {Current Branch
:} \
5497 -textvariable current_branch \
5501 pack .branch.l1
-side left
5502 pack .branch.cb
-side left
-fill x
5503 pack .branch
-side top
-fill x
5505 if {[is_enabled branch
]} {
5507 .mbar.merge add
command -label {Local Merge...
} \
5508 -command do_local_merge \
5510 lappend disable_on_lock \
5511 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
5512 .mbar.merge add
command -label {Abort Merge...
} \
5513 -command do_reset_hard \
5515 lappend disable_on_lock \
5516 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
5522 .mbar.push add
command -label {Push...
} \
5523 -command do_push_anywhere \
5527 # -- Main Window Layout
5529 panedwindow .vpane
-orient vertical
5530 panedwindow .vpane.files
-orient horizontal
5531 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
5532 pack .vpane
-anchor n
-side top
-fill both
-expand 1
5534 # -- Index File List
5536 frame .vpane.files.index
-height 100 -width 200
5537 label .vpane.files.index.title
-text {Changes To Be Committed
} \
5540 text
$ui_index -background white
-borderwidth 0 \
5541 -width 20 -height 10 \
5544 -cursor $cursor_ptr \
5545 -xscrollcommand {.vpane.files.index.sx
set} \
5546 -yscrollcommand {.vpane.files.index.sy
set} \
5548 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
5549 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
5550 pack .vpane.files.index.title
-side top
-fill x
5551 pack .vpane.files.index.sx
-side bottom
-fill x
5552 pack .vpane.files.index.sy
-side right
-fill y
5553 pack
$ui_index -side left
-fill both
-expand 1
5554 .vpane.files add .vpane.files.index
-sticky nsew
5556 # -- Working Directory File List
5558 frame .vpane.files.workdir
-height 100 -width 200
5559 label .vpane.files.workdir.title
-text {Changed But Not Updated
} \
5562 text
$ui_workdir -background white
-borderwidth 0 \
5563 -width 20 -height 10 \
5566 -cursor $cursor_ptr \
5567 -xscrollcommand {.vpane.files.workdir.sx
set} \
5568 -yscrollcommand {.vpane.files.workdir.sy
set} \
5570 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
5571 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
5572 pack .vpane.files.workdir.title
-side top
-fill x
5573 pack .vpane.files.workdir.sx
-side bottom
-fill x
5574 pack .vpane.files.workdir.sy
-side right
-fill y
5575 pack
$ui_workdir -side left
-fill both
-expand 1
5576 .vpane.files add .vpane.files.workdir
-sticky nsew
5578 foreach i
[list
$ui_index $ui_workdir] {
5579 $i tag conf in_diff
-font font_uibold
5580 $i tag conf in_sel \
5581 -background [$i cget
-foreground] \
5582 -foreground [$i cget
-background]
5586 # -- Diff and Commit Area
5588 frame .vpane.lower
-height 300 -width 400
5589 frame .vpane.lower.commarea
5590 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
5591 pack .vpane.lower.commarea
-side top
-fill x
5592 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
5593 .vpane add .vpane.lower
-sticky nsew
5595 # -- Commit Area Buttons
5597 frame .vpane.lower.commarea.buttons
5598 label .vpane.lower.commarea.buttons.l
-text {} \
5602 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
5603 pack .vpane.lower.commarea.buttons
-side left
-fill y
5605 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
5606 -command do_rescan \
5608 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
5609 lappend disable_on_lock \
5610 {.vpane.lower.commarea.buttons.rescan conf
-state}
5612 button .vpane.lower.commarea.buttons.incall
-text {Add Existing
} \
5613 -command do_add_all \
5615 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
5616 lappend disable_on_lock \
5617 {.vpane.lower.commarea.buttons.incall conf
-state}
5619 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
5620 -command do_signoff \
5622 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
5624 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
5625 -command do_commit \
5627 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
5628 lappend disable_on_lock \
5629 {.vpane.lower.commarea.buttons.commit conf
-state}
5631 # -- Commit Message Buffer
5633 frame .vpane.lower.commarea.buffer
5634 frame .vpane.lower.commarea.buffer.header
5635 set ui_comm .vpane.lower.commarea.buffer.t
5636 set ui_coml .vpane.lower.commarea.buffer.header.l
5637 radiobutton .vpane.lower.commarea.buffer.header.new \
5638 -text {New Commit
} \
5639 -command do_select_commit_type \
5640 -variable selected_commit_type \
5643 lappend disable_on_lock \
5644 [list .vpane.lower.commarea.buffer.header.new conf
-state]
5645 radiobutton .vpane.lower.commarea.buffer.header.amend \
5646 -text {Amend Last Commit
} \
5647 -command do_select_commit_type \
5648 -variable selected_commit_type \
5651 lappend disable_on_lock \
5652 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
5657 proc trace_commit_type
{varname args
} {
5658 global ui_coml commit_type
5659 switch
-glob -- $commit_type {
5660 initial
{set txt
{Initial Commit Message
:}}
5661 amend
{set txt
{Amended Commit Message
:}}
5662 amend-initial
{set txt
{Amended Initial Commit Message
:}}
5663 amend-merge
{set txt
{Amended Merge Commit Message
:}}
5664 merge
{set txt
{Merge Commit Message
:}}
5665 * {set txt
{Commit Message
:}}
5667 $ui_coml conf
-text $txt
5669 trace add variable commit_type
write trace_commit_type
5670 pack
$ui_coml -side left
-fill x
5671 pack .vpane.lower.commarea.buffer.header.amend
-side right
5672 pack .vpane.lower.commarea.buffer.header.new
-side right
5674 text
$ui_comm -background white
-borderwidth 1 \
5677 -autoseparators true \
5679 -width 75 -height 9 -wrap none \
5681 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
5682 scrollbar .vpane.lower.commarea.buffer.sby \
5683 -command [list
$ui_comm yview
]
5684 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
5685 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
5686 pack
$ui_comm -side left
-fill y
5687 pack .vpane.lower.commarea.buffer
-side left
-fill y
5689 # -- Commit Message Buffer Context Menu
5691 set ctxm .vpane.lower.commarea.buffer.ctxm
5692 menu
$ctxm -tearoff 0
5696 -command {tk_textCut
$ui_comm}
5700 -command {tk_textCopy
$ui_comm}
5704 -command {tk_textPaste
$ui_comm}
5708 -command {$ui_comm delete sel.first sel.last
}
5711 -label {Select All
} \
5713 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
5718 $ui_comm tag add sel
0.0 end
5719 tk_textCopy
$ui_comm
5720 $ui_comm tag remove sel
0.0 end
5727 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
5731 proc trace_current_diff_path
{varname args
} {
5732 global current_diff_path diff_actions file_states
5733 if {$current_diff_path eq
{}} {
5739 set p
$current_diff_path
5740 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
5742 set p
[escape_path
$p]
5746 .vpane.lower.
diff.header.status configure
-text $s
5747 .vpane.lower.
diff.header.
file configure
-text $f
5748 .vpane.lower.
diff.header.path configure
-text $p
5749 foreach w
$diff_actions {
5753 trace add variable current_diff_path
write trace_current_diff_path
5755 frame .vpane.lower.
diff.header
-background orange
5756 label .vpane.lower.
diff.header.status \
5757 -background orange \
5758 -width $max_status_desc \
5762 label .vpane.lower.
diff.header.
file \
5763 -background orange \
5767 label .vpane.lower.
diff.header.path \
5768 -background orange \
5772 pack .vpane.lower.
diff.header.status
-side left
5773 pack .vpane.lower.
diff.header.
file -side left
5774 pack .vpane.lower.
diff.header.path
-fill x
5775 set ctxm .vpane.lower.
diff.header.ctxm
5776 menu
$ctxm -tearoff 0
5785 -- $current_diff_path
5787 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5788 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
5792 frame .vpane.lower.
diff.body
5793 set ui_diff .vpane.lower.
diff.body.t
5794 text
$ui_diff -background white
-borderwidth 0 \
5795 -width 80 -height 15 -wrap none \
5797 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
5798 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
5800 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
5801 -command [list
$ui_diff xview
]
5802 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
5803 -command [list
$ui_diff yview
]
5804 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
5805 pack .vpane.lower.
diff.body.sby
-side right
-fill y
5806 pack
$ui_diff -side left
-fill both
-expand 1
5807 pack .vpane.lower.
diff.header
-side top
-fill x
5808 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
5810 $ui_diff tag conf d_cr
-elide true
5811 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
5812 $ui_diff tag conf d_
+ -foreground {#00a000}
5813 $ui_diff tag conf d_-
-foreground red
5815 $ui_diff tag conf d_
++ -foreground {#00a000}
5816 $ui_diff tag conf d_--
-foreground red
5817 $ui_diff tag conf d_
+s \
5818 -foreground {#00a000} \
5819 -background {#e2effa}
5820 $ui_diff tag conf d_-s \
5822 -background {#e2effa}
5823 $ui_diff tag conf d_s
+ \
5824 -foreground {#00a000} \
5826 $ui_diff tag conf d_s- \
5830 $ui_diff tag conf d
<<<<<<< \
5831 -foreground orange \
5833 $ui_diff tag conf d
======= \
5834 -foreground orange \
5836 $ui_diff tag conf d
>>>>>>> \
5837 -foreground orange \
5840 $ui_diff tag raise sel
5842 # -- Diff Body Context Menu
5844 set ctxm .vpane.lower.
diff.body.ctxm
5845 menu
$ctxm -tearoff 0
5849 -command reshow_diff
5850 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5854 -command {tk_textCopy
$ui_diff}
5855 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5857 -label {Select All
} \
5859 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
5860 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5865 $ui_diff tag add sel
0.0 end
5866 tk_textCopy
$ui_diff
5867 $ui_diff tag remove sel
0.0 end
5869 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5872 -label {Apply
/Reverse Hunk
} \
5874 -command {apply_hunk
$cursorX $cursorY}
5875 set ui_diff_applyhunk
[$ctxm index last
]
5876 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
5879 -label {Decrease Font Size
} \
5881 -command {incr_font_size font_diff
-1}
5882 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5884 -label {Increase Font Size
} \
5886 -command {incr_font_size font_diff
1}
5887 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5890 -label {Show Less Context
} \
5892 -command {if {$repo_config(gui.diffcontext
) >= 2} {
5893 incr repo_config
(gui.diffcontext
) -1
5896 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5898 -label {Show More Context
} \
5901 incr repo_config
(gui.diffcontext
)
5904 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5906 $ctxm add
command -label {Options...
} \
5909 bind_button3
$ui_diff "
5912 if {\$ui_index eq \$current_diff_side} {
5913 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5915 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5917 tk_popup $ctxm %X %Y
5919 unset ui_diff_applyhunk
5923 label .status
-textvariable ui_status_value \
5929 pack .status
-anchor w
-side bottom
-fill x
5934 set gm
$repo_config(gui.geometry
)
5935 wm geometry .
[lindex
$gm 0]
5936 .vpane sash place
0 \
5937 [lindex
[.vpane sash coord
0] 0] \
5939 .vpane.files sash place
0 \
5941 [lindex
[.vpane.files sash coord
0] 1]
5947 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
5948 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
5949 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
5950 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
5951 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
5952 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
5953 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
5954 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
5955 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
5956 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
5957 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
5959 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
5960 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
5961 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
5962 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
5963 bind $ui_diff <$M1B-Key-v> {break}
5964 bind $ui_diff <$M1B-Key-V> {break}
5965 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
5966 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
5967 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
5968 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
5969 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
5970 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
5971 bind $ui_diff <Button-1
> {focus
%W
}
5973 if {[is_enabled branch
]} {
5974 bind .
<$M1B-Key-n> do_create_branch
5975 bind .
<$M1B-Key-N> do_create_branch
5978 bind all
<Key-F5
> do_rescan
5979 bind all
<$M1B-Key-r> do_rescan
5980 bind all
<$M1B-Key-R> do_rescan
5981 bind .
<$M1B-Key-s> do_signoff
5982 bind .
<$M1B-Key-S> do_signoff
5983 bind .
<$M1B-Key-i> do_add_all
5984 bind .
<$M1B-Key-I> do_add_all
5985 bind .
<$M1B-Key-Return> do_commit
5986 foreach i
[list
$ui_index $ui_workdir] {
5987 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
5988 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
5989 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
5993 set file_lists
($ui_index) [list
]
5994 set file_lists
($ui_workdir) [list
]
5996 wm title .
"[appname] ([file normalize [file dirname [gitdir]]])"
5997 focus
-force $ui_comm
5999 # -- Warn the user about environmental problems. Cygwin's Tcl
6000 # does *not* pass its env array onto any processes it spawns.
6001 # This means that git processes get none of our environment.
6006 set msg
"Possible environment issues exist.
6008 The following environment variables are probably
6009 going to be ignored by any Git subprocess run
6013 foreach name
[array names env
] {
6014 switch
-regexp -- $name {
6015 {^GIT_INDEX_FILE$
} -
6016 {^GIT_OBJECT_DIRECTORY$
} -
6017 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
6019 {^GIT_EXTERNAL_DIFF$
} -
6023 {^GIT_CONFIG_LOCAL$
} -
6024 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
6025 append msg
" - $name\n"
6028 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
6029 append msg
" - $name\n"
6031 set suggest_user
$name
6035 if {$ignored_env > 0} {
6037 This is due to a known issue with the
6038 Tcl binary distributed by Cygwin."
6040 if {$suggest_user ne
{}} {
6043 A good replacement for $suggest_user
6044 is placing values for the user.name and
6045 user.email settings into your personal
6051 unset ignored_env msg suggest_user name
6054 # -- Only initialize complex UI if we are going to stay running.
6056 if {[is_enabled transport
]} {
6060 populate_branch_menu
6065 # -- Only suggest a gc run if we are going to stay running.
6067 if {[is_enabled multicommit
]} {
6068 set object_limit
2000
6069 if {[is_Windows
]} {set object_limit
200}
6070 regexp
{^
([0-9]+) objects
,} [git count-objects
] _junk objects_current
6071 if {$objects_current >= $object_limit} {
6073 "This repository currently has $objects_current loose objects.
6075 To maintain optimal performance it is strongly
6076 recommended that you compress the database
6077 when more than $object_limit loose objects exist.
6079 Compress the database now?"] eq
yes} {
6083 unset object_limit _junk objects_current
6086 lock_index begin-read