2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2006 Shawn Pearce, Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 set appname
[lindex
[file split $argv0] end
]
13 ######################################################################
17 proc is_many_config
{name
} {
18 switch
-glob -- $name {
27 proc load_config
{include_global
} {
28 global repo_config global_config default_config
30 array
unset global_config
31 if {$include_global} {
33 set fd_rc
[open
"| git repo-config --global --list" r
]
34 while {[gets
$fd_rc line
] >= 0} {
35 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
36 if {[is_many_config
$name]} {
37 lappend global_config
($name) $value
39 set global_config
($name) $value
47 array
unset repo_config
49 set fd_rc
[open
"| git repo-config --list" r
]
50 while {[gets
$fd_rc line
] >= 0} {
51 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
52 if {[is_many_config
$name]} {
53 lappend repo_config
($name) $value
55 set repo_config
($name) $value
62 foreach name
[array names default_config
] {
63 if {[catch
{set v
$global_config($name)}]} {
64 set global_config
($name) $default_config($name)
66 if {[catch
{set v
$repo_config($name)}]} {
67 set repo_config
($name) $default_config($name)
73 global default_config font_descs
74 global repo_config global_config
75 global repo_config_new global_config_new
77 foreach option
$font_descs {
78 set name
[lindex
$option 0]
79 set font
[lindex
$option 1]
80 font configure
$font \
81 -family $global_config_new(gui.
$font^^family
) \
82 -size $global_config_new(gui.
$font^^size
)
83 font configure
${font}bold \
84 -family $global_config_new(gui.
$font^^family
) \
85 -size $global_config_new(gui.
$font^^size
)
86 set global_config_new
(gui.
$name) [font configure
$font]
87 unset global_config_new
(gui.
$font^^family
)
88 unset global_config_new
(gui.
$font^^size
)
91 foreach name
[array names default_config
] {
92 set value
$global_config_new($name)
93 if {$value ne
$global_config($name)} {
94 if {$value eq
$default_config($name)} {
95 catch
{exec git repo-config
--global --unset $name}
97 regsub
-all "\[{}\]" $value {"} value
98 exec git repo-config --global $name $value
100 set global_config($name) $value
101 if {$value eq $repo_config($name)} {
102 catch {exec git repo-config --unset $name}
103 set repo_config($name) $value
108 foreach name [array names default_config] {
109 set value $repo_config_new($name)
110 if {$value ne $repo_config($name)} {
111 if {$value eq $global_config($name)} {
112 catch {exec git repo-config --unset $name}
114 regsub -all "\
[{}\
]" $value {"} value
115 exec git repo-config
$name $value
117 set repo_config
($name) $value
122 proc error_popup
{msg
} {
123 global gitdir appname
128 append title
[lindex \
129 [file split [file normalize
[file dirname $gitdir]]] \
133 set cmd
[list tk_messageBox \
136 -title "$title: error" \
138 if {[winfo ismapped .
]} {
139 lappend cmd
-parent .
144 proc info_popup
{msg
} {
145 global gitdir appname
150 append title
[lindex \
151 [file split [file normalize
[file dirname $gitdir]]] \
163 ######################################################################
167 if { [catch
{set gitdir
$env(GIT_DIR
)}]
168 && [catch
{set gitdir
[exec git rev-parse
--git-dir]} err
]} {
169 catch
{wm withdraw .
}
170 error_popup
"Cannot find the git directory:\n\n$err"
173 if {![file isdirectory
$gitdir]} {
174 catch
{wm withdraw .
}
175 error_popup
"Git directory not found:\n\n$gitdir"
178 if {[lindex
[file split $gitdir] end
] ne
{.git
}} {
179 catch
{wm withdraw .
}
180 error_popup
"Cannot use funny .git directory:\n\n$gitdir"
183 if {[catch
{cd [file dirname $gitdir]} err
]} {
184 catch
{wm withdraw .
}
185 error_popup
"No working directory [file dirname $gitdir]:\n\n$err"
190 if {$appname eq
{git-citool
}} {
194 ######################################################################
202 set disable_on_lock
[list
]
203 set index_lock_type none
205 proc lock_index
{type} {
206 global index_lock_type disable_on_lock
208 if {$index_lock_type eq
{none
}} {
209 set index_lock_type
$type
210 foreach w
$disable_on_lock {
211 uplevel
#0 $w disabled
214 } elseif
{$index_lock_type eq
"begin-$type"} {
215 set index_lock_type
$type
221 proc unlock_index
{} {
222 global index_lock_type disable_on_lock
224 set index_lock_type none
225 foreach w
$disable_on_lock {
230 ######################################################################
234 proc repository_state
{hdvar ctvar
} {
236 upvar
$hdvar hd
$ctvar ct
238 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
241 } elseif
{[file exists
[file join $gitdir MERGE_HEAD
]]} {
249 global PARENT empty_tree
254 if {$empty_tree eq
{}} {
255 set empty_tree
[exec git mktree
<< {}]
260 proc rescan
{after
} {
261 global HEAD PARENT commit_type
262 global ui_index ui_other ui_status_value ui_comm
263 global rescan_active file_states
266 if {$rescan_active > 0 ||
![lock_index
read]} return
268 repository_state new_HEAD new_type
269 if {[string match amend
* $commit_type]
270 && $new_type eq
{normal
}
271 && $new_HEAD eq
$HEAD} {
275 set commit_type
$new_type
278 array
unset file_states
280 if {![$ui_comm edit modified
]
281 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
282 if {[load_message GITGUI_MSG
]} {
283 } elseif
{[load_message MERGE_MSG
]} {
284 } elseif
{[load_message SQUASH_MSG
]} {
286 $ui_comm edit modified false
290 if {$repo_config(gui.trustmtime
) eq
{true
}} {
291 rescan_stage2
{} $after
294 set ui_status_value
{Refreshing
file status...
}
295 set cmd
[list git update-index
]
297 lappend cmd
--unmerged
298 lappend cmd
--ignore-missing
299 lappend cmd
--refresh
300 set fd_rf
[open
"| $cmd" r
]
301 fconfigure
$fd_rf -blocking 0 -translation binary
302 fileevent
$fd_rf readable \
303 [list rescan_stage2
$fd_rf $after]
307 proc rescan_stage2
{fd after
} {
308 global gitdir ui_status_value
309 global rescan_active buf_rdi buf_rdf buf_rlo
313 if {![eof
$fd]} return
317 set ls_others
[list | git ls-files
--others -z \
318 --exclude-per-directory=.gitignore
]
319 set info_exclude
[file join $gitdir info exclude
]
320 if {[file readable
$info_exclude]} {
321 lappend ls_others
"--exclude-from=$info_exclude"
329 set ui_status_value
{Scanning
for modified files ...
}
330 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
331 set fd_df
[open
"| git diff-files -z" r
]
332 set fd_lo
[open
$ls_others r
]
334 fconfigure
$fd_di -blocking 0 -translation binary
335 fconfigure
$fd_df -blocking 0 -translation binary
336 fconfigure
$fd_lo -blocking 0 -translation binary
337 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
338 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
339 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
342 proc load_message
{file} {
343 global gitdir ui_comm
345 set f
[file join $gitdir $file]
346 if {[file isfile
$f]} {
347 if {[catch
{set fd
[open
$f r
]}]} {
350 set content
[string trim
[read $fd]]
352 $ui_comm delete
0.0 end
353 $ui_comm insert end
$content
359 proc read_diff_index
{fd after
} {
362 append buf_rdi
[read $fd]
364 set n
[string length
$buf_rdi]
366 set z1
[string first
"\0" $buf_rdi $c]
369 set z2
[string first
"\0" $buf_rdi $z1]
373 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
375 [string range
$buf_rdi $z1 [expr {$z2 - 1}]] \
377 [list
[lindex
$i 0] [lindex
$i 2]] \
383 set buf_rdi
[string range
$buf_rdi $c end
]
388 rescan_done
$fd buf_rdi
$after
391 proc read_diff_files
{fd after
} {
394 append buf_rdf
[read $fd]
396 set n
[string length
$buf_rdf]
398 set z1
[string first
"\0" $buf_rdf $c]
401 set z2
[string first
"\0" $buf_rdf $z1]
405 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
407 [string range
$buf_rdf $z1 [expr {$z2 - 1}]] \
410 [list
[lindex
$i 0] [lindex
$i 2]]
415 set buf_rdf
[string range
$buf_rdf $c end
]
420 rescan_done
$fd buf_rdf
$after
423 proc read_ls_others
{fd after
} {
426 append buf_rlo
[read $fd]
427 set pck
[split $buf_rlo "\0"]
428 set buf_rlo
[lindex
$pck end
]
429 foreach p
[lrange
$pck 0 end-1
] {
432 rescan_done
$fd buf_rlo
$after
435 proc rescan_done
{fd buf after
} {
437 global file_states repo_config
440 if {![eof
$fd]} return
443 if {[incr rescan_active
-1] > 0} return
449 if {$repo_config(gui.partialinclude
) ne
{true
}} {
451 foreach path
[array names file_states
] {
452 switch
-- [lindex
$file_states($path) 0] {
454 MM
{lappend pathList
$path}
457 if {$pathList ne
{}} {
459 "Updating included files" \
461 [concat
{reshow_diff
;} $after]
470 proc prune_selection
{} {
471 global file_states selected_paths
473 foreach path
[array names selected_paths
] {
474 if {[catch
{set still_here
$file_states($path)}]} {
475 unset selected_paths
($path)
480 ######################################################################
485 global ui_diff current_diff ui_index ui_other
487 $ui_diff conf
-state normal
488 $ui_diff delete
0.0 end
489 $ui_diff conf
-state disabled
493 $ui_index tag remove in_diff
0.0 end
494 $ui_other tag remove in_diff
0.0 end
497 proc reshow_diff
{} {
498 global current_diff ui_status_value file_states
500 if {$current_diff eq
{}
501 ||
[catch
{set s
$file_states($current_diff)}]} {
504 show_diff
$current_diff
508 proc handle_empty_diff
{} {
509 global current_diff file_states file_lists
511 set path
$current_diff
512 set s
$file_states($path)
513 if {[lindex
$s 0] ne
{_M
}} return
515 info_popup
"No differences detected.
517 [short_path $path] has no changes.
519 The modification date of this file was updated
520 by another application and you currently have
521 the Trust File Modification Timestamps option
522 enabled, so Git did not automatically detect
523 that there are no content differences in this
526 This file will now be removed from the modified
527 files list, to prevent possible confusion.
529 if {[catch
{exec git update-index
-- $path} err
]} {
530 error_popup
"Failed to refresh index:\n\n$err"
534 set old_w
[mapcol
[lindex
$file_states($path) 0] $path]
535 set lno
[lsearch
-sorted $file_lists($old_w) $path]
537 set file_lists
($old_w) \
538 [lreplace
$file_lists($old_w) $lno $lno]
540 $old_w conf
-state normal
541 $old_w delete
$lno.0 [expr {$lno + 1}].0
542 $old_w conf
-state disabled
546 proc show_diff
{path
{w
{}} {lno
{}}} {
547 global file_states file_lists
548 global is_3way_diff diff_active repo_config
549 global ui_diff current_diff ui_status_value
551 if {$diff_active ||
![lock_index
read]} return
554 if {$w eq
{} ||
$lno == {}} {
555 foreach w
[array names file_lists
] {
556 set lno
[lsearch
-sorted $file_lists($w) $path]
563 if {$w ne
{} && $lno >= 1} {
564 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
567 set s
$file_states($path)
571 set current_diff
$path
572 set ui_status_value
"Loading diff of [escape_path $path]..."
574 set cmd
[list | git diff-index
]
575 lappend cmd
--no-color
576 if {$repo_config(gui.diffcontext
) > 0} {
577 lappend cmd
"-U$repo_config(gui.diffcontext)"
587 set fd
[open
$path r
]
588 set content
[read $fd]
593 set ui_status_value
"Unable to display [escape_path $path]"
594 error_popup
"Error loading file:\n\n$err"
597 $ui_diff conf
-state normal
598 $ui_diff insert end
$content
599 $ui_diff conf
-state disabled
602 set ui_status_value
{Ready.
}
611 if {[catch
{set fd
[open
$cmd r
]} err
]} {
614 set ui_status_value
"Unable to display [escape_path $path]"
615 error_popup
"Error loading diff:\n\n$err"
619 fconfigure
$fd -blocking 0 -translation auto
620 fileevent
$fd readable
[list read_diff
$fd]
623 proc read_diff
{fd
} {
624 global ui_diff ui_status_value is_3way_diff diff_active
627 $ui_diff conf
-state normal
628 while {[gets
$fd line
] >= 0} {
629 # -- Cleanup uninteresting diff header lines.
631 if {[string match
{diff --git *} $line]} continue
632 if {[string match
{diff --combined *} $line]} continue
633 if {[string match
{--- *} $line]} continue
634 if {[string match
{+++ *} $line]} continue
635 if {$line eq
{deleted
file mode
120000}} {
636 set line
"deleted symlink"
639 # -- Automatically detect if this is a 3 way diff.
641 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
643 # -- Reformat a 3 way diff, 'cause its too weird.
646 set op
[string range
$line 0 1]
649 {++} {set tags d_
+ ; set op
{ +}}
650 {--} {set tags d_-
; set op
{ -}}
651 { +} {set tags d_
++; set op
{++}}
652 { -} {set tags d_--
; set op
{--}}
653 {+ } {set tags d_-
+; set op
{-+}}
654 {- } {set tags d_
+-; set op
{+-}}
655 default
{set tags
{}}
657 set line
[string replace
$line 0 1 $op]
659 switch
-- [string index
$line 0] {
663 default
{set tags
{}}
666 $ui_diff insert end
$line $tags
667 $ui_diff insert end
"\n" $tags
669 $ui_diff conf
-state disabled
675 set ui_status_value
{Ready.
}
677 if {$repo_config(gui.trustmtime
) eq
{true
}
678 && [$ui_diff index end
] eq
{2.0}} {
684 ######################################################################
688 proc load_last_commit
{} {
689 global HEAD PARENT commit_type ui_comm
691 if {[string match amend
* $commit_type]} return
692 if {$commit_type ne
{normal
}} {
693 error_popup
"Can't amend a $commit_type commit."
701 set fd
[open
"| git cat-file commit $HEAD" r
]
702 while {[gets
$fd line
] > 0} {
703 if {[string match
{parent
*} $line]} {
704 set parent
[string range
$line 7 end
]
708 set msg
[string trim
[read $fd]]
711 error_popup
"Error loading commit data for amend:\n\n$err"
715 if {$parent_count > 1} {
716 error_popup
{Can
't amend a merge commit.}
720 if {$parent_count == 0} {
721 set commit_type amend-initial
723 } elseif {$parent_count == 1} {
724 set commit_type amend
728 $ui_comm delete 0.0 end
729 $ui_comm insert end $msg
730 $ui_comm edit modified false
732 rescan {set ui_status_value {Ready.}}
735 proc create_new_commit {} {
736 global commit_type ui_comm
738 set commit_type normal
739 $ui_comm delete 0.0 end
740 $ui_comm edit modified false
742 rescan {set ui_status_value {Ready.}}
745 set GIT_COMMITTER_IDENT {}
747 proc committer_ident {} {
748 global GIT_COMMITTER_IDENT
750 if {$GIT_COMMITTER_IDENT eq {}} {
751 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
752 error_popup "Unable to obtain your identity:\n\n$err"
755 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
756 $me me GIT_COMMITTER_IDENT]} {
757 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
762 return $GIT_COMMITTER_IDENT
765 proc commit_tree {} {
766 global HEAD commit_type file_states ui_comm repo_config
768 if {![lock_index update]} return
769 if {[committer_ident] eq {}} return
771 # -- Our in memory state should match the repository.
773 repository_state curHEAD cur_type
774 if {[string match amend* $commit_type]
775 && $cur_type eq {normal}
776 && $curHEAD eq $HEAD} {
777 } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
778 info_popup {Last scanned state does not match repository state.
780 Another Git program has modified this repository
781 since the last scan. A rescan must be performed
782 before another commit can be created.
784 The rescan will be automatically started now.
787 rescan {set ui_status_value {Ready.}}
791 # -- At least one file should differ in the index.
794 foreach path [array names file_states] {
795 switch -glob -- [lindex $file_states($path) 0] {
799 M? {set files_ready 1; break}
801 error_popup "Unmerged files cannot be committed.
803 File [short_path $path] has merge conflicts.
804 You must resolve them and include the file before committing.
810 error_popup "Unknown file state [lindex $s 0] detected.
812 File [short_path $path] cannot be committed by this program.
818 error_popup {No included files to commit.
820 You must include at least 1 file before you can commit.
826 # -- A message is required.
828 set msg [string trim [$ui_comm get 1.0 end]]
830 error_popup {Please supply a commit message.
832 A good commit message has the following format:
834 - First line: Describe in one sentance what you did.
836 - Remaining lines: Describe why this change is good.
842 # -- Update included files if partialincludes are off.
844 if {$repo_config(gui.partialinclude) ne {true}} {
846 foreach path [array names file_states] {
847 switch -glob -- [lindex $file_states($path) 0] {
849 M? {lappend pathList $path}
852 if {$pathList ne {}} {
855 "Updating included files" \
857 [concat {lock_index update;} \
858 [list commit_prehook $curHEAD $msg]]
863 commit_prehook $curHEAD $msg
866 proc commit_prehook {curHEAD msg} {
867 global tcl_platform gitdir ui_status_value pch_error
869 # On Cygwin [file executable] might lie so we need to ask
870 # the shell if the hook is executable. Yes that's annoying.
872 set pchook
[file join $gitdir hooks pre-commit
]
873 if {$tcl_platform(platform
) eq
{windows
}
874 && [file isfile
$pchook]} {
875 set pchook
[list sh
-c [concat \
876 "if test -x \"$pchook\";" \
877 "then exec \"$pchook\" 2>&1;" \
879 } elseif
{[file executable
$pchook]} {
880 set pchook
[list
$pchook |
& cat]
882 commit_writetree
$curHEAD $msg
886 set ui_status_value
{Calling pre-commit hook...
}
888 set fd_ph
[open
"| $pchook" r
]
889 fconfigure
$fd_ph -blocking 0 -translation binary
890 fileevent
$fd_ph readable \
891 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
894 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
895 global pch_error ui_status_value
897 append pch_error
[read $fd_ph]
898 fconfigure
$fd_ph -blocking 1
900 if {[catch
{close
$fd_ph}]} {
901 set ui_status_value
{Commit declined by pre-commit hook.
}
902 hook_failed_popup pre-commit
$pch_error
905 commit_writetree
$curHEAD $msg
910 fconfigure
$fd_ph -blocking 0
913 proc commit_writetree
{curHEAD msg
} {
914 global ui_status_value
916 set ui_status_value
{Committing changes...
}
917 set fd_wt
[open
"| git write-tree" r
]
918 fileevent
$fd_wt readable \
919 [list commit_committree
$fd_wt $curHEAD $msg]
922 proc commit_committree
{fd_wt curHEAD msg
} {
923 global single_commit gitdir HEAD PARENT commit_type tcl_platform
924 global ui_status_value ui_comm selected_commit_type
925 global file_states selected_paths rescan_active
928 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
929 error_popup
"write-tree failed:\n\n$err"
930 set ui_status_value
{Commit failed.
}
935 # -- Create the commit.
937 set cmd
[list git commit-tree
$tree_id]
939 lappend cmd
-p $PARENT
941 if {$commit_type eq
{merge
}} {
943 set fd_mh
[open
[file join $gitdir MERGE_HEAD
] r
]
944 while {[gets
$fd_mh merge_head
] >= 0} {
945 lappend cmd
-p $merge_head
949 error_popup
"Loading MERGE_HEAD failed:\n\n$err"
950 set ui_status_value
{Commit failed.
}
956 # git commit-tree writes to stderr during initial commit.
957 lappend cmd
2>/dev
/null
960 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
961 error_popup
"commit-tree failed:\n\n$err"
962 set ui_status_value
{Commit failed.
}
967 # -- Update the HEAD ref.
970 if {$commit_type ne
{normal
}} {
971 append reflogm
" ($commit_type)"
973 set i
[string first
"\n" $msg]
975 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
977 append reflogm
{: } $msg
979 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
980 if {[catch
{eval exec $cmd} err
]} {
981 error_popup
"update-ref failed:\n\n$err"
982 set ui_status_value
{Commit failed.
}
987 # -- Cleanup after ourselves.
989 catch
{file delete
[file join $gitdir MERGE_HEAD
]}
990 catch
{file delete
[file join $gitdir MERGE_MSG
]}
991 catch
{file delete
[file join $gitdir SQUASH_MSG
]}
992 catch
{file delete
[file join $gitdir GITGUI_MSG
]}
994 # -- Let rerere do its thing.
996 if {[file isdirectory
[file join $gitdir rr-cache
]]} {
997 catch
{exec git rerere
}
1000 # -- Run the post-commit hook.
1002 set pchook
[file join $gitdir hooks post-commit
]
1003 if {$tcl_platform(platform
) eq
{windows
} && [file isfile
$pchook]} {
1004 set pchook
[list sh
-c [concat \
1005 "if test -x \"$pchook\";" \
1006 "then exec \"$pchook\";" \
1008 } elseif
{![file executable
$pchook]} {
1011 if {$pchook ne
{}} {
1012 catch
{exec $pchook &}
1015 $ui_comm delete
0.0 end
1016 $ui_comm edit modified false
1019 if {$single_commit} do_quit
1021 # -- Update in memory status
1023 set commit_type normal
1024 set selected_commit_type new
1028 foreach path
[array names file_states
] {
1029 set s
$file_states($path)
1031 switch
-glob -- $m {
1039 unset file_states
($path)
1040 catch
{unset selected_paths
($path)}
1043 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1049 set file_states
($path) [list \
1050 _
[string index
$m 1] \
1061 set ui_status_value \
1062 "Changes committed as [string range $cmt_id 0 7]."
1065 ######################################################################
1069 proc fetch_from
{remote
} {
1070 set w
[new_console
"fetch $remote" \
1071 "Fetching new changes from $remote"]
1072 set cmd
[list git fetch
]
1074 console_exec
$w $cmd
1077 proc pull_remote
{remote branch
} {
1078 global HEAD commit_type file_states repo_config
1080 if {![lock_index update
]} return
1082 # -- Our in memory state should match the repository.
1084 repository_state curHEAD cur_type
1085 if {$commit_type ne
$cur_type ||
$HEAD ne
$curHEAD} {
1086 error_popup
{Last scanned state does not match repository state.
1088 Its highly likely that another Git program modified the
1089 repository since our last scan. A rescan is required
1090 before a pull can be started.
1093 rescan
{set ui_status_value
{Ready.
}}
1097 # -- No differences should exist before a pull.
1099 if {[array size file_states
] != 0} {
1100 error_popup
{Uncommitted but modified files are present.
1102 You should not perform a pull with unmodified files
in your working
1103 directory as Git would be unable to recover from an incorrect merge.
1105 Commit or throw away all changes before starting a pull operation.
1111 set w
[new_console
"pull $remote $branch" \
1112 "Pulling new changes from branch $branch in $remote"]
1113 set cmd
[list git pull
]
1114 if {$repo_config(gui.pullsummary
) eq
{false
}} {
1115 lappend cmd
--no-summary
1119 console_exec
$w $cmd [list post_pull_remote
$remote $branch]
1122 proc post_pull_remote
{remote branch success
} {
1123 global HEAD PARENT commit_type selected_commit_type
1124 global ui_status_value
1128 repository_state HEAD commit_type
1130 set selected_commit_type new
1131 set $ui_status_value "Pulling $branch from $remote complete."
1133 set m
"Conflicts detected while pulling $branch from $remote."
1134 rescan
"set ui_status_value {$m}"
1138 proc push_to
{remote
} {
1139 set w
[new_console
"push $remote" \
1140 "Pushing changes to $remote"]
1141 set cmd
[list git push
]
1143 console_exec
$w $cmd
1146 ######################################################################
1150 proc mapcol
{state path
} {
1151 global all_cols ui_other
1153 if {[catch
{set r
$all_cols($state)}]} {
1154 puts
"error: no column for state={$state} $path"
1160 proc mapicon
{state path
} {
1163 if {[catch
{set r
$all_icons($state)}]} {
1164 puts
"error: no icon for state={$state} $path"
1170 proc mapdesc
{state path
} {
1173 if {[catch
{set r
$all_descs($state)}]} {
1174 puts
"error: no desc for state={$state} $path"
1180 proc escape_path
{path
} {
1181 regsub
-all "\n" $path "\\n" path
1185 proc short_path
{path
} {
1186 return [escape_path
[lindex
[file split $path] end
]]
1190 set null_sha1
[string repeat
0 40]
1192 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1193 global file_states next_icon_id null_sha1
1195 set s0
[string index
$new_state 0]
1196 set s1
[string index
$new_state 1]
1198 if {[catch
{set info
$file_states($path)}]} {
1200 set icon n
[incr next_icon_id
]
1202 set state
[lindex
$info 0]
1203 set icon
[lindex
$info 1]
1204 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1205 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1208 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1209 elseif
{$s0 eq
{_
}} {set s0 _
}
1211 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1212 elseif
{$s1 eq
{_
}} {set s1 _
}
1214 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1215 set head_info
[list
0 $null_sha1]
1216 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1217 && $head_info eq
{}} {
1218 set head_info
$index_info
1221 set file_states
($path) [list
$s0$s1 $icon \
1222 $head_info $index_info \
1227 proc display_file
{path state
} {
1228 global file_states file_lists selected_paths
1230 set old_m
[merge_state
$path $state]
1231 set s
$file_states($path)
1232 set new_m
[lindex
$s 0]
1233 set new_w
[mapcol
$new_m $path]
1234 set old_w
[mapcol
$old_m $path]
1235 set new_icon
[mapicon
$new_m $path]
1237 if {$new_w ne
$old_w} {
1238 set lno
[lsearch
-sorted $file_lists($old_w) $path]
1241 $old_w conf
-state normal
1242 $old_w delete
$lno.0 [expr {$lno + 1}].0
1243 $old_w conf
-state disabled
1246 lappend file_lists
($new_w) $path
1247 set file_lists
($new_w) [lsort
$file_lists($new_w)]
1248 set lno
[lsearch
-sorted $file_lists($new_w) $path]
1250 $new_w conf
-state normal
1251 $new_w image create
$lno.0 \
1252 -align center
-padx 5 -pady 1 \
1253 -name [lindex
$s 1] \
1255 $new_w insert
$lno.1 "[escape_path $path]\n"
1256 if {[catch
{set in_sel
$selected_paths($path)}]} {
1260 $new_w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1262 $new_w conf
-state disabled
1263 } elseif
{$new_icon ne
[mapicon
$old_m $path]} {
1264 $new_w conf
-state normal
1265 $new_w image conf
[lindex
$s 1] -image $new_icon
1266 $new_w conf
-state disabled
1270 proc display_all_files
{} {
1271 global ui_index ui_other
1272 global file_states file_lists
1273 global last_clicked selected_paths
1275 $ui_index conf
-state normal
1276 $ui_other conf
-state normal
1278 $ui_index delete
0.0 end
1279 $ui_other delete
0.0 end
1282 set file_lists
($ui_index) [list
]
1283 set file_lists
($ui_other) [list
]
1285 foreach path
[lsort
[array names file_states
]] {
1286 set s
$file_states($path)
1288 set w
[mapcol
$m $path]
1289 lappend file_lists
($w) $path
1290 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1291 $w image create end \
1292 -align center
-padx 5 -pady 1 \
1293 -name [lindex
$s 1] \
1294 -image [mapicon
$m $path]
1295 $w insert end
"[escape_path $path]\n"
1296 if {[catch
{set in_sel
$selected_paths($path)}]} {
1300 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1304 $ui_index conf
-state disabled
1305 $ui_other conf
-state disabled
1308 proc update_indexinfo
{msg pathList after
} {
1309 global update_index_cp ui_status_value
1311 if {![lock_index update
]} return
1313 set update_index_cp
0
1314 set pathList
[lsort
$pathList]
1315 set totalCnt
[llength
$pathList]
1316 set batch [expr {int
($totalCnt * .01) + 1}]
1317 if {$batch > 25} {set batch 25}
1319 set ui_status_value
[format \
1320 "$msg... %i/%i files (%.2f%%)" \
1324 set fd
[open
"| git update-index -z --index-info" w
]
1330 fileevent
$fd writable
[list \
1331 write_update_indexinfo \
1341 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1342 global update_index_cp ui_status_value
1343 global file_states current_diff
1345 if {$update_index_cp >= $totalCnt} {
1352 for {set i
$batch} \
1353 {$update_index_cp < $totalCnt && $i > 0} \
1355 set path
[lindex
$pathList $update_index_cp]
1356 incr update_index_cp
1358 set s
$file_states($path)
1359 switch
-glob -- [lindex
$s 0] {
1365 set info
[lindex
$s 2]
1366 if {$info eq
{}} continue
1368 puts
-nonewline $fd $info
1369 puts
-nonewline $fd "\t"
1370 puts
-nonewline $fd $path
1371 puts
-nonewline $fd "\0"
1372 display_file
$path $new
1375 set ui_status_value
[format \
1376 "$msg... %i/%i files (%.2f%%)" \
1379 [expr {100.0 * $update_index_cp / $totalCnt}]]
1382 proc update_index
{msg pathList after
} {
1383 global update_index_cp ui_status_value
1385 if {![lock_index update
]} return
1387 set update_index_cp
0
1388 set pathList
[lsort
$pathList]
1389 set totalCnt
[llength
$pathList]
1390 set batch [expr {int
($totalCnt * .01) + 1}]
1391 if {$batch > 25} {set batch 25}
1393 set ui_status_value
[format \
1394 "$msg... %i/%i files (%.2f%%)" \
1398 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1404 fileevent
$fd writable
[list \
1405 write_update_index \
1415 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1416 global update_index_cp ui_status_value
1417 global file_states current_diff
1419 if {$update_index_cp >= $totalCnt} {
1426 for {set i
$batch} \
1427 {$update_index_cp < $totalCnt && $i > 0} \
1429 set path
[lindex
$pathList $update_index_cp]
1430 incr update_index_cp
1432 switch
-glob -- [lindex
$file_states($path) 0] {
1448 puts
-nonewline $fd $path
1449 puts
-nonewline $fd "\0"
1450 display_file
$path $new
1453 set ui_status_value
[format \
1454 "$msg... %i/%i files (%.2f%%)" \
1457 [expr {100.0 * $update_index_cp / $totalCnt}]]
1460 ######################################################################
1462 ## remote management
1464 proc load_all_remotes
{} {
1465 global gitdir all_remotes repo_config
1467 set all_remotes
[list
]
1468 set rm_dir
[file join $gitdir remotes
]
1469 if {[file isdirectory
$rm_dir]} {
1470 set all_remotes
[concat
$all_remotes [glob \
1474 -directory $rm_dir *]]
1477 foreach line
[array names repo_config remote.
*.url
] {
1478 if {[regexp ^remote\.
(.
*)\.url\$
$line line name
]} {
1479 lappend all_remotes
$name
1483 set all_remotes
[lsort
-unique $all_remotes]
1486 proc populate_fetch_menu
{m
} {
1487 global gitdir all_remotes repo_config
1489 foreach r
$all_remotes {
1491 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
1492 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
1497 set fd
[open
[file join $gitdir remotes
$r] r
]
1498 while {[gets
$fd n
] >= 0} {
1499 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
1510 -label "Fetch from $r..." \
1511 -command [list fetch_from
$r] \
1517 proc populate_push_menu
{m
} {
1518 global gitdir all_remotes repo_config
1520 foreach r
$all_remotes {
1522 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
1523 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
1528 set fd
[open
[file join $gitdir remotes
$r] r
]
1529 while {[gets
$fd n
] >= 0} {
1530 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
1541 -label "Push to $r..." \
1542 -command [list push_to
$r] \
1548 proc populate_pull_menu
{m
} {
1549 global gitdir repo_config all_remotes disable_on_lock
1551 foreach remote
$all_remotes {
1553 if {[array get repo_config remote.
$remote.url
] ne
{}} {
1554 if {[array get repo_config remote.
$remote.fetch
] ne
{}} {
1555 regexp
{^
([^
:]+):} \
1556 [lindex
$repo_config(remote.
$remote.fetch
) 0] \
1561 set fd
[open
[file join $gitdir remotes
$remote] r
]
1562 while {[gets
$fd line
] >= 0} {
1563 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $line line rb
]} {
1572 regsub ^refs
/heads
/ $rb {} rb_short
1573 if {$rb_short ne
{}} {
1575 -label "Branch $rb_short from $remote..." \
1576 -command [list pull_remote
$remote $rb] \
1578 lappend disable_on_lock \
1579 [list
$m entryconf
[$m index last
] -state]
1584 ######################################################################
1589 #define mask_width 14
1590 #define mask_height 15
1591 static unsigned char mask_bits
[] = {
1592 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1593 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1594 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1597 image create bitmap file_plain
-background white
-foreground black
-data {
1598 #define plain_width 14
1599 #define plain_height 15
1600 static unsigned char plain_bits
[] = {
1601 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1602 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1603 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1604 } -maskdata $filemask
1606 image create bitmap file_mod
-background white
-foreground blue
-data {
1607 #define mod_width 14
1608 #define mod_height 15
1609 static unsigned char mod_bits
[] = {
1610 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1611 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1612 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1613 } -maskdata $filemask
1615 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
1616 #define file_fulltick_width 14
1617 #define file_fulltick_height 15
1618 static unsigned char file_fulltick_bits
[] = {
1619 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1620 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1621 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1622 } -maskdata $filemask
1624 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1625 #define parttick_width 14
1626 #define parttick_height 15
1627 static unsigned char parttick_bits
[] = {
1628 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1629 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1630 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1631 } -maskdata $filemask
1633 image create bitmap file_question
-background white
-foreground black
-data {
1634 #define file_question_width 14
1635 #define file_question_height 15
1636 static unsigned char file_question_bits
[] = {
1637 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1638 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1639 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1640 } -maskdata $filemask
1642 image create bitmap file_removed
-background white
-foreground red
-data {
1643 #define file_removed_width 14
1644 #define file_removed_height 15
1645 static unsigned char file_removed_bits
[] = {
1646 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1647 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1648 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1649 } -maskdata $filemask
1651 image create bitmap file_merge
-background white
-foreground blue
-data {
1652 #define file_merge_width 14
1653 #define file_merge_height 15
1654 static unsigned char file_merge_bits
[] = {
1655 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1656 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1657 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1658 } -maskdata $filemask
1660 set ui_index .vpane.files.index.list
1661 set ui_other .vpane.files.other.list
1662 set max_status_desc
0
1664 {__ i plain
"Unmodified"}
1665 {_M i mod
"Modified"}
1666 {M_ i fulltick
"Included in commit"}
1667 {MM i parttick
"Partially included"}
1669 {_O o plain
"Untracked"}
1670 {A_ o fulltick
"Added by commit"}
1671 {AM o parttick
"Partially added"}
1672 {AD o question
"Added (but now gone)"}
1674 {_D i question
"Missing"}
1675 {DD i removed
"Removed by commit"}
1676 {DO i removed
"Removed (still exists)"}
1677 {DM i removed
"Removed (but modified)"}
1679 {UM i merge
"Merge conflicts"}
1680 {U_ i merge
"Merge conflicts"}
1682 if {$max_status_desc < [string length
[lindex
$i 3]]} {
1683 set max_status_desc
[string length
[lindex
$i 3]]
1685 if {[lindex
$i 1] eq
{i
}} {
1686 set all_cols
([lindex
$i 0]) $ui_index
1688 set all_cols
([lindex
$i 0]) $ui_other
1690 set all_icons
([lindex
$i 0]) file_
[lindex
$i 2]
1691 set all_descs
([lindex
$i 0]) [lindex
$i 3]
1695 ######################################################################
1700 global tcl_platform tk_library
1701 if {$tcl_platform(platform
) eq
{unix
}
1702 && $tcl_platform(os
) eq
{Darwin
}
1703 && [string match
/Library
/Frameworks
/* $tk_library]} {
1709 proc bind_button3
{w cmd
} {
1710 bind $w <Any-Button-3
> $cmd
1712 bind $w <Control-Button-1
> $cmd
1716 proc incr_font_size
{font
{amt
1}} {
1717 set sz
[font configure
$font -size]
1719 font configure
$font -size $sz
1720 font configure
${font}bold
-size $sz
1723 proc hook_failed_popup
{hook msg
} {
1724 global gitdir appname
1730 label
$w.m.l1
-text "$hook hook failed:" \
1735 -background white
-borderwidth 1 \
1737 -width 80 -height 10 \
1739 -yscrollcommand [list
$w.m.sby
set]
1741 -text {You must correct the above errors before committing.
} \
1745 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
1746 pack
$w.m.l1
-side top
-fill x
1747 pack
$w.m.l2
-side bottom
-fill x
1748 pack
$w.m.sby
-side right
-fill y
1749 pack
$w.m.t
-side left
-fill both
-expand 1
1750 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
1752 $w.m.t insert
1.0 $msg
1753 $w.m.t conf
-state disabled
1755 button
$w.ok
-text OK \
1758 -command "destroy $w"
1759 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
1761 bind $w <Visibility
> "grab $w; focus $w"
1762 bind $w <Key-Return
> "destroy $w"
1763 wm title
$w "$appname ([lindex [file split \
1764 [file normalize [file dirname $gitdir]]] \
1769 set next_console_id
0
1771 proc new_console
{short_title long_title
} {
1772 global next_console_id console_data
1773 set w .console
[incr next_console_id
]
1774 set console_data
($w) [list
$short_title $long_title]
1775 return [console_init
$w]
1778 proc console_init
{w
} {
1779 global console_cr console_data
1780 global gitdir appname M1B
1782 set console_cr
($w) 1.0
1785 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
1790 -background white
-borderwidth 1 \
1792 -width 80 -height 10 \
1795 -yscrollcommand [list
$w.m.sby
set]
1796 label
$w.m.s
-text {Working... please
wait...
} \
1800 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
1801 pack
$w.m.l1
-side top
-fill x
1802 pack
$w.m.s
-side bottom
-fill x
1803 pack
$w.m.sby
-side right
-fill y
1804 pack
$w.m.t
-side left
-fill both
-expand 1
1805 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
1807 menu
$w.ctxm
-tearoff 0
1808 $w.ctxm add
command -label "Copy" \
1810 -command "tk_textCopy $w.m.t"
1811 $w.ctxm add
command -label "Select All" \
1813 -command "$w.m.t tag add sel 0.0 end"
1814 $w.ctxm add
command -label "Copy All" \
1817 $w.m.t tag add sel 0.0 end
1819 $w.m.t tag remove sel 0.0 end
1822 button
$w.ok
-text {Close
} \
1825 -command "destroy $w"
1826 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
1828 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
1829 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1830 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1831 bind $w <Visibility
> "focus $w"
1832 wm title
$w "$appname ([lindex [file split \
1833 [file normalize [file dirname $gitdir]]] \
1834 end]): [lindex $console_data($w) 0]"
1838 proc console_exec
{w cmd
{after
{}}} {
1841 # -- Windows tosses the enviroment when we exec our child.
1842 # But most users need that so we have to relogin. :-(
1844 if {$tcl_platform(platform
) eq
{windows
}} {
1845 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
1848 # -- Tcl won't let us redirect both stdout and stderr to
1849 # the same pipe. So pass it through cat...
1851 set cmd
[concat |
$cmd |
& cat]
1853 set fd_f
[open
$cmd r
]
1854 fconfigure
$fd_f -blocking 0 -translation binary
1855 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
1858 proc console_read
{w fd after
} {
1859 global console_cr console_data
1863 if {![winfo exists
$w]} {console_init
$w}
1864 $w.m.t conf
-state normal
1866 set n
[string length
$buf]
1868 set cr
[string first
"\r" $buf $c]
1869 set lf
[string first
"\n" $buf $c]
1870 if {$cr < 0} {set cr
[expr {$n + 1}]}
1871 if {$lf < 0} {set lf
[expr {$n + 1}]}
1874 $w.m.t insert end
[string range
$buf $c $lf]
1875 set console_cr
($w) [$w.m.t index
{end
-1c}]
1879 $w.m.t delete
$console_cr($w) end
1880 $w.m.t insert end
"\n"
1881 $w.m.t insert end
[string range
$buf $c $cr]
1886 $w.m.t conf
-state disabled
1890 fconfigure
$fd -blocking 1
1892 if {[catch
{close
$fd}]} {
1893 if {![winfo exists
$w]} {console_init
$w}
1894 $w.m.s conf
-background red
-text {Error
: Command Failed
}
1895 $w.ok conf
-state normal
1897 } elseif
{[winfo exists
$w]} {
1898 $w.m.s conf
-background green
-text {Success
}
1899 $w.ok conf
-state normal
1902 array
unset console_cr
$w
1903 array
unset console_data
$w
1905 uplevel
#0 $after $ok
1909 fconfigure
$fd -blocking 0
1912 ######################################################################
1916 set starting_gitk_msg
{Please
wait... Starting gitk...
}
1919 global tcl_platform ui_status_value starting_gitk_msg
1921 set ui_status_value
$starting_gitk_msg
1923 if {$ui_status_value eq
$starting_gitk_msg} {
1924 set ui_status_value
{Ready.
}
1928 if {$tcl_platform(platform
) eq
{windows
}} {
1936 set w
[new_console
"repack" "Repacking the object database"]
1937 set cmd
[list git repack
]
1940 console_exec
$w $cmd
1946 global gitdir ui_comm is_quitting repo_config
1948 if {$is_quitting} return
1951 # -- Stash our current commit buffer.
1953 set save
[file join $gitdir GITGUI_MSG
]
1954 set msg
[string trim
[$ui_comm get
0.0 end
]]
1955 if {[$ui_comm edit modified
] && $msg ne
{}} {
1957 set fd
[open
$save w
]
1958 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
1961 } elseif
{$msg eq
{} && [file exists
$save]} {
1965 # -- Stash our current window geometry into this repository.
1967 set cfg_geometry
[list
]
1968 lappend cfg_geometry
[wm geometry .
]
1969 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1970 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1971 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1974 if {$cfg_geometry ne
$rc_geometry} {
1975 catch
{exec git repo-config gui.geometry
$cfg_geometry}
1982 rescan
{set ui_status_value
{Ready.
}}
1985 proc remove_helper
{txt paths
} {
1986 global file_states current_diff
1988 if {![lock_index begin-update
]} return
1992 foreach path
$paths {
1993 switch
-glob -- [lindex
$file_states($path) 0] {
1997 lappend pathList
$path
1998 if {$path eq
$current_diff} {
1999 set after
{reshow_diff
;}
2004 if {$pathList eq
{}} {
2010 [concat
$after {set ui_status_value
{Ready.
}}]
2014 proc do_remove_selection
{} {
2015 global current_diff selected_paths
2017 if {[array size selected_paths
] > 0} {
2019 {Removing selected files from commit
} \
2020 [array names selected_paths
]
2021 } elseif
{$current_diff ne
{}} {
2023 "Removing [short_path $current_diff] from commit" \
2024 [list
$current_diff]
2028 proc include_helper
{txt paths
} {
2029 global file_states current_diff
2031 if {![lock_index begin-update
]} return
2035 foreach path
$paths {
2036 switch
-- [lindex
$file_states($path) 0] {
2045 lappend pathList
$path
2046 if {$path eq
$current_diff} {
2047 set after
{reshow_diff
;}
2052 if {$pathList eq
{}} {
2058 [concat
$after {set ui_status_value
{Ready to commit.
}}]
2062 proc do_include_selection
{} {
2063 global current_diff selected_paths
2065 if {[array size selected_paths
] > 0} {
2067 {Including selected files
} \
2068 [array names selected_paths
]
2069 } elseif
{$current_diff ne
{}} {
2071 "Including [short_path $current_diff]" \
2072 [list
$current_diff]
2076 proc do_include_all
{} {
2080 foreach path
[array names file_states
] {
2081 switch
-- [lindex
$file_states($path) 0] {
2086 _D
{lappend paths
$path}
2090 {Including all modified files
} \
2094 proc do_signoff
{} {
2097 set me
[committer_ident
]
2098 if {$me eq
{}} return
2100 set sob
"Signed-off-by: $me"
2101 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
2102 if {$last ne
$sob} {
2103 $ui_comm edit separator
2105 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
2106 $ui_comm insert end
"\n"
2108 $ui_comm insert end
"\n$sob"
2109 $ui_comm edit separator
2114 proc do_select_commit_type
{} {
2115 global commit_type selected_commit_type
2117 if {$selected_commit_type eq
{new
}
2118 && [string match amend
* $commit_type]} {
2120 } elseif
{$selected_commit_type eq
{amend
}
2121 && ![string match amend
* $commit_type]} {
2124 # The amend request was rejected...
2126 if {![string match amend
* $commit_type]} {
2127 set selected_commit_type new
2136 proc do_options
{} {
2137 global appname gitdir font_descs
2138 global repo_config global_config
2139 global repo_config_new global_config_new
2141 array
unset repo_config_new
2142 array
unset global_config_new
2143 foreach name
[array names repo_config
] {
2144 set repo_config_new
($name) $repo_config($name)
2147 foreach name
[array names repo_config
] {
2149 gui.diffcontext
{continue}
2151 set repo_config_new
($name) $repo_config($name)
2153 foreach name
[array names global_config
] {
2154 set global_config_new
($name) $global_config($name)
2156 set reponame
[lindex
[file split \
2157 [file normalize
[file dirname $gitdir]]] \
2160 set w .options_editor
2162 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2164 label
$w.header
-text "$appname Options" \
2166 pack
$w.header
-side top
-fill x
2169 button
$w.buttons.restore
-text {Restore Defaults
} \
2171 -command do_restore_defaults
2172 pack
$w.buttons.restore
-side left
2173 button
$w.buttons.save
-text Save \
2175 -command [list do_save_config
$w]
2176 pack
$w.buttons.save
-side right
2177 button
$w.buttons.cancel
-text {Cancel
} \
2179 -command [list destroy
$w]
2180 pack
$w.buttons.cancel
-side right
2181 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2183 labelframe
$w.repo
-text "$reponame Repository" \
2185 -relief raised
-borderwidth 2
2186 labelframe
$w.global
-text {Global
(All Repositories
)} \
2188 -relief raised
-borderwidth 2
2189 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
2190 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
2193 {b partialinclude
{Allow Partially Included Files
}}
2194 {b pullsummary
{Show Pull Summary
}}
2195 {b trustmtime
{Trust File Modification Timestamps
}}
2196 {i diffcontext
{Number of Diff Context Lines
}}
2198 set type [lindex
$option 0]
2199 set name
[lindex
$option 1]
2200 set text
[lindex
$option 2]
2201 foreach f
{repo global
} {
2204 checkbutton
$w.
$f.
$name -text $text \
2205 -variable ${f}_config_new
(gui.
$name) \
2209 pack
$w.
$f.
$name -side top
-anchor w
2213 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
2214 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
2215 spinbox
$w.
$f.
$name.v \
2216 -textvariable ${f}_config_new
(gui.
$name) \
2217 -from 1 -to 99 -increment 1 \
2220 pack
$w.
$f.
$name.v
-side right
-anchor e
2221 pack
$w.
$f.
$name -side top
-anchor w
-fill x
2227 set all_fonts
[lsort
[font families
]]
2228 foreach option
$font_descs {
2229 set name
[lindex
$option 0]
2230 set font
[lindex
$option 1]
2231 set text
[lindex
$option 2]
2233 set global_config_new
(gui.
$font^^family
) \
2234 [font configure
$font -family]
2235 set global_config_new
(gui.
$font^^size
) \
2236 [font configure
$font -size]
2238 frame
$w.global.
$name
2239 label
$w.global.
$name.l
-text "$text:" -font font_ui
2240 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
2241 eval tk_optionMenu
$w.global.
$name.family \
2242 global_config_new
(gui.
$font^^family
) \
2244 spinbox
$w.global.
$name.size \
2245 -textvariable global_config_new
(gui.
$font^^size
) \
2246 -from 2 -to 80 -increment 1 \
2249 pack
$w.global.
$name.size
-side right
-anchor e
2250 pack
$w.global.
$name.family
-side right
-anchor e
2251 pack
$w.global.
$name -side top
-anchor w
-fill x
2254 bind $w <Visibility
> "grab $w; focus $w"
2255 bind $w <Key-Escape
> "destroy $w"
2256 wm title
$w "$appname ($reponame): Options"
2260 proc do_restore_defaults
{} {
2261 global font_descs default_config repo_config
2262 global repo_config_new global_config_new
2264 foreach name
[array names default_config
] {
2265 set repo_config_new
($name) $default_config($name)
2266 set global_config_new
($name) $default_config($name)
2269 foreach option
$font_descs {
2270 set name
[lindex
$option 0]
2271 set repo_config
(gui.
$name) $default_config(gui.
$name)
2275 foreach option
$font_descs {
2276 set name
[lindex
$option 0]
2277 set font
[lindex
$option 1]
2278 set global_config_new
(gui.
$font^^family
) \
2279 [font configure
$font -family]
2280 set global_config_new
(gui.
$font^^size
) \
2281 [font configure
$font -size]
2285 proc do_save_config
{w
} {
2286 if {[catch
{save_config
} err
]} {
2287 error_popup
"Failed to completely save options:\n\n$err"
2293 proc do_windows_shortcut
{} {
2294 global gitdir appname argv0
2296 set reponame
[lindex
[file split \
2297 [file normalize
[file dirname $gitdir]]] \
2301 set desktop
[exec cygpath \
2309 set fn
[tk_getSaveFile \
2311 -title "$appname ($reponame): Create Desktop Icon" \
2312 -initialdir $desktop \
2313 -initialfile "Git $reponame.bat"]
2317 set sh
[exec cygpath \
2322 set me
[exec cygpath \
2326 set gd
[exec cygpath \
2330 regsub
-all ' $me "'\\''" me
2331 regsub -all ' $gd "'\\''" gd
2332 puts -nonewline $fd "\"$sh\" --login -c \""
2333 puts -nonewline $fd "GIT_DIR='$gd'"
2334 puts -nonewline $fd " '$me'"
2338 error_popup "Cannot write script:\n\n$err"
2343 proc do_macosx_app {} {
2344 global gitdir appname argv0 env
2346 set reponame [lindex [file split \
2347 [file normalize [file dirname $gitdir]]] \
2350 set fn [tk_getSaveFile \
2352 -title "$appname ($reponame): Create Desktop Icon" \
2353 -initialdir [file join $env(HOME) Desktop] \
2354 -initialfile "Git $reponame.app"]
2357 set Contents [file join $fn Contents]
2358 set MacOS [file join $Contents MacOS]
2359 set exe [file join $MacOS git-gui]
2363 set fd [open [file join $Contents Info.plist] w]
2364 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2365 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2366 <plist version="1.0">
2368 <key>CFBundleDevelopmentRegion</key>
2369 <string>English</string>
2370 <key>CFBundleExecutable</key>
2371 <string>git-gui</string>
2372 <key>CFBundleIdentifier</key>
2373 <string>org.spearce.git-gui</string>
2374 <key>CFBundleInfoDictionaryVersion</key>
2375 <string>6.0</string>
2376 <key>CFBundlePackageType</key>
2377 <string>APPL</string>
2378 <key>CFBundleSignature</key>
2379 <string>????</string>
2380 <key>CFBundleVersion</key>
2381 <string>1.0</string>
2382 <key>NSPrincipalClass</key>
2383 <string>NSApplication</string>
2388 set fd [open $exe w]
2389 set gd [file normalize $gitdir]
2390 set ep [file normalize [exec git --exec-path]]
2391 regsub -all ' $gd "'\\''" gd
2392 regsub
-all ' $ep "'\\''" ep
2393 puts $fd "#!/bin/sh"
2394 foreach name
[array names env
] {
2395 if {[string match GIT_
* $name]} {
2396 regsub
-all ' $env($name) "'\\''" v
2397 puts $fd "export $name='$v'"
2400 puts $fd "export PATH
='$ep':\
$PATH"
2401 puts $fd "export GIT_DIR
='$gd'"
2402 puts $fd "exec [file normalize
$argv0]"
2405 file attributes $exe -permissions u+x,g+x,o+x
2407 error_popup "Cannot
write icon
:\n\n$err"
2412 proc toggle_or_diff {w x y} {
2413 global file_states file_lists current_diff ui_index ui_other
2414 global last_clicked selected_paths
2416 set pos [split [$w index @$x,$y] .]
2417 set lno [lindex $pos 0]
2418 set col [lindex $pos 1]
2419 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2425 set last_clicked [list $w $lno]
2426 array unset selected_paths
2427 $ui_index tag remove in_sel 0.0 end
2428 $ui_other tag remove in_sel 0.0 end
2431 if {$current_diff eq $path} {
2432 set after {reshow_diff;}
2436 switch -glob -- [lindex $file_states($path) 0] {
2442 "Removing
[short_path
$path] from commit
" \
2444 [concat $after {set ui_status_value {Ready.}}]
2448 "Including
[short_path
$path]" \
2450 [concat $after {set ui_status_value {Ready.}}]
2454 show_diff $path $w $lno
2458 proc add_one_to_selection {w x y} {
2460 global last_clicked selected_paths
2462 set pos [split [$w index @$x,$y] .]
2463 set lno [lindex $pos 0]
2464 set col [lindex $pos 1]
2465 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2471 set last_clicked [list $w $lno]
2472 if {[catch {set in_sel $selected_paths($path)}]} {
2476 unset selected_paths($path)
2477 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2479 set selected_paths($path) 1
2480 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2484 proc add_range_to_selection {w x y} {
2486 global last_clicked selected_paths
2488 if {[lindex $last_clicked 0] ne $w} {
2489 toggle_or_diff $w $x $y
2493 set pos [split [$w index @$x,$y] .]
2494 set lno [lindex $pos 0]
2495 set lc [lindex $last_clicked 1]
2504 foreach path [lrange $file_lists($w) \
2505 [expr {$begin - 1}] \
2506 [expr {$end - 1}]] {
2507 set selected_paths($path) 1
2509 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2512 ######################################################################
2516 set cursor_ptr arrow
2517 font create font_diff -family Courier -size 10
2521 eval font configure font_ui [font actual [.dummy cget -font]]
2525 font create font_uibold
2526 font create font_diffbold
2530 if {$tcl_platform(platform) eq {windows}} {
2533 } elseif {[is_MacOSX]} {
2538 proc apply_config {} {
2539 global repo_config font_descs
2541 foreach option $font_descs {
2542 set name [lindex $option 0]
2543 set font [lindex $option 1]
2545 foreach {cn cv} $repo_config(gui.$name) {
2546 font configure $font $cn $cv
2549 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
2551 foreach {cn cv} [font configure $font] {
2552 font configure ${font}bold $cn $cv
2554 font configure ${font}bold -weight bold
2558 set default_config(gui.trustmtime) false
2559 set default_config(gui.pullsummary) true
2560 set default_config(gui.partialinclude) false
2561 set default_config(gui.diffcontext) 5
2562 set default_config(gui.fontui) [font configure font_ui]
2563 set default_config(gui.fontdiff) [font configure font_diff]
2565 {fontui font_ui {Main Font}}
2566 {fontdiff font_diff {Diff/Console Font}}
2571 ######################################################################
2577 menu .mbar -tearoff 0
2578 .mbar add cascade -label Project -menu .mbar.project
2579 .mbar add cascade -label Edit -menu .mbar.edit
2580 .mbar add cascade -label Commit -menu .mbar.commit
2581 if {!$single_commit} {
2582 .mbar add cascade -label Fetch -menu .mbar.fetch
2583 .mbar add cascade -label Pull -menu .mbar.pull
2584 .mbar add cascade -label Push -menu .mbar.push
2586 . configure -menu .mbar
2591 .mbar.project add command -label Visualize \
2594 if {!$single_commit} {
2595 .mbar.project add command -label {Repack Database} \
2596 -command do_repack \
2599 if {$tcl_platform(platform) eq {windows}} {
2600 .mbar.project add command \
2601 -label {Create Desktop Icon} \
2602 -command do_windows_shortcut \
2604 } elseif {[is_MacOSX]} {
2605 .mbar.project add command \
2606 -label {Create Desktop Icon} \
2607 -command do_macosx_app \
2611 .mbar.project add command -label Quit \
2613 -accelerator $M1T-Q \
2619 .mbar.edit add command -label Undo \
2620 -command {catch {[focus] edit undo}} \
2621 -accelerator $M1T-Z \
2623 .mbar.edit add command -label Redo \
2624 -command {catch {[focus] edit redo}} \
2625 -accelerator $M1T-Y \
2627 .mbar.edit add separator
2628 .mbar.edit add command -label Cut \
2629 -command {catch {tk_textCut [focus]}} \
2630 -accelerator $M1T-X \
2632 .mbar.edit add command -label Copy \
2633 -command {catch {tk_textCopy [focus]}} \
2634 -accelerator $M1T-C \
2636 .mbar.edit add command -label Paste \
2637 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2638 -accelerator $M1T-V \
2640 .mbar.edit add command -label Delete \
2641 -command {catch {[focus] delete sel.first sel.last}} \
2644 .mbar.edit add separator
2645 .mbar.edit add command -label {Select All} \
2646 -command {catch {[focus] tag add sel 0.0 end}} \
2647 -accelerator $M1T-A \
2649 .mbar.edit add separator
2650 .mbar.edit add command -label {Options...} \
2651 -command do_options \
2658 .mbar.commit add radiobutton \
2659 -label {New Commit} \
2660 -command do_select_commit_type \
2661 -variable selected_commit_type \
2664 lappend disable_on_lock \
2665 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2667 .mbar.commit add radiobutton \
2668 -label {Amend Last Commit} \
2669 -command do_select_commit_type \
2670 -variable selected_commit_type \
2673 lappend disable_on_lock \
2674 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2676 .mbar.commit add separator
2678 .mbar.commit add command -label Rescan \
2679 -command do_rescan \
2682 lappend disable_on_lock \
2683 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2685 .mbar.commit add command -label {Remove From Commit} \
2686 -command do_remove_selection \
2688 lappend disable_on_lock \
2689 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2691 .mbar.commit add command -label {Include In Commit} \
2692 -command do_include_selection \
2694 lappend disable_on_lock \
2695 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2697 .mbar.commit add command -label {Include All} \
2698 -command do_include_all \
2699 -accelerator $M1T-I \
2701 lappend disable_on_lock \
2702 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2704 .mbar.commit add separator
2706 .mbar.commit add command -label {Sign Off} \
2707 -command do_signoff \
2708 -accelerator $M1T-S \
2711 .mbar.commit add command -label Commit \
2712 -command do_commit \
2713 -accelerator $M1T-Return \
2715 lappend disable_on_lock \
2716 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2718 # -- Transport menus
2720 if {!$single_commit} {
2726 # -- Main Window Layout
2728 panedwindow .vpane -orient vertical
2729 panedwindow .vpane.files -orient horizontal
2730 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2731 pack .vpane -anchor n -side top -fill both -expand 1
2733 # -- Index File List
2735 frame .vpane.files.index -height 100 -width 400
2736 label .vpane.files.index.title -text {Modified Files} \
2739 text $ui_index -background white -borderwidth 0 \
2740 -width 40 -height 10 \
2742 -cursor $cursor_ptr \
2743 -yscrollcommand {.vpane.files.index.sb set} \
2745 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2746 pack .vpane.files.index.title -side top -fill x
2747 pack .vpane.files.index.sb -side right -fill y
2748 pack $ui_index -side left -fill both -expand 1
2749 .vpane.files add .vpane.files.index -sticky nsew
2751 # -- Other (Add) File List
2753 frame .vpane.files.other -height 100 -width 100
2754 label .vpane.files.other.title -text {Untracked Files} \
2757 text $ui_other -background white -borderwidth 0 \
2758 -width 40 -height 10 \
2760 -cursor $cursor_ptr \
2761 -yscrollcommand {.vpane.files.other.sb set} \
2763 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2764 pack .vpane.files.other.title -side top -fill x
2765 pack .vpane.files.other.sb -side right -fill y
2766 pack $ui_other -side left -fill both -expand 1
2767 .vpane.files add .vpane.files.other -sticky nsew
2769 foreach i [list $ui_index $ui_other] {
2770 $i tag conf in_diff -font font_uibold
2771 $i tag conf in_sel \
2772 -background [$i cget -foreground] \
2773 -foreground [$i cget -background]
2777 # -- Diff and Commit Area
2779 frame .vpane.lower -height 300 -width 400
2780 frame .vpane.lower.commarea
2781 frame .vpane.lower.diff -relief sunken -borderwidth 1
2782 pack .vpane.lower.commarea -side top -fill x
2783 pack .vpane.lower.diff -side bottom -fill both -expand 1
2784 .vpane add .vpane.lower -stick nsew
2786 # -- Commit Area Buttons
2788 frame .vpane.lower.commarea.buttons
2789 label .vpane.lower.commarea.buttons.l -text {} \
2793 pack .vpane.lower.commarea.buttons.l -side top -fill x
2794 pack .vpane.lower.commarea.buttons -side left -fill y
2796 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2797 -command do_rescan \
2799 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2800 lappend disable_on_lock \
2801 {.vpane.lower.commarea.buttons.rescan conf -state}
2803 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2804 -command do_include_all \
2806 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2807 lappend disable_on_lock \
2808 {.vpane.lower.commarea.buttons.incall conf -state}
2810 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2811 -command do_signoff \
2813 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2815 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2816 -command do_commit \
2818 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2819 lappend disable_on_lock \
2820 {.vpane.lower.commarea.buttons.commit conf -state}
2822 # -- Commit Message Buffer
2824 frame .vpane.lower.commarea.buffer
2825 frame .vpane.lower.commarea.buffer.header
2826 set ui_comm .vpane.lower.commarea.buffer.t
2827 set ui_coml .vpane.lower.commarea.buffer.header.l
2828 radiobutton .vpane.lower.commarea.buffer.header.new \
2829 -text {New Commit} \
2830 -command do_select_commit_type \
2831 -variable selected_commit_type \
2834 lappend disable_on_lock \
2835 [list .vpane.lower.commarea.buffer.header.new conf -state]
2836 radiobutton .vpane.lower.commarea.buffer.header.amend \
2837 -text {Amend Last Commit} \
2838 -command do_select_commit_type \
2839 -variable selected_commit_type \
2842 lappend disable_on_lock \
2843 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2848 proc trace_commit_type {varname args} {
2849 global ui_coml commit_type
2850 switch -glob -- $commit_type {
2851 initial {set txt {Initial Commit Message:}}
2852 amend {set txt {Amended Commit Message:}}
2853 amend-initial {set txt {Amended Initial Commit Message:}}
2854 merge {set txt {Merge Commit Message:}}
2855 * {set txt {Commit Message:}}
2857 $ui_coml conf -text $txt
2859 trace add variable commit_type write trace_commit_type
2860 pack $ui_coml -side left -fill x
2861 pack .vpane.lower.commarea.buffer.header.amend -side right
2862 pack .vpane.lower.commarea.buffer.header.new -side right
2864 text $ui_comm -background white -borderwidth 1 \
2867 -autoseparators true \
2869 -width 75 -height 9 -wrap none \
2871 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2872 scrollbar .vpane.lower.commarea.buffer.sby \
2873 -command [list $ui_comm yview]
2874 pack .vpane.lower.commarea.buffer.header -side top -fill x
2875 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2876 pack $ui_comm -side left -fill y
2877 pack .vpane.lower.commarea.buffer -side left -fill y
2879 # -- Commit Message Buffer Context Menu
2881 set ctxm .vpane.lower.commarea.buffer.ctxm
2882 menu $ctxm -tearoff 0
2886 -command {tk_textCut $ui_comm}
2890 -command {tk_textCopy $ui_comm}
2894 -command {tk_textPaste $ui_comm}
2898 -command {$ui_comm delete sel.first sel.last}
2901 -label {Select All} \
2903 -command {$ui_comm tag add sel 0.0 end}
2908 $ui_comm tag add sel 0.0 end
2909 tk_textCopy $ui_comm
2910 $ui_comm tag remove sel 0.0 end
2917 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
2922 set diff_actions [list]
2923 proc trace_current_diff {varname args} {
2924 global current_diff diff_actions file_states
2925 if {$current_diff eq {}} {
2932 set s [mapdesc [lindex $file_states($p) 0] $p]
2934 set p [escape_path $p]
2938 .vpane.lower.diff.header.status configure -text $s
2939 .vpane.lower.diff.header.file configure -text $f
2940 .vpane.lower.diff.header.path configure -text $p
2941 foreach w $diff_actions {
2945 trace add variable current_diff write trace_current_diff
2947 frame .vpane.lower.diff.header -background orange
2948 label .vpane.lower.diff.header.status \
2949 -background orange \
2950 -width $max_status_desc \
2954 label .vpane.lower.diff.header.file \
2955 -background orange \
2959 label .vpane.lower.diff.header.path \
2960 -background orange \
2964 pack .vpane.lower.diff.header.status -side left
2965 pack .vpane.lower.diff.header.file -side left
2966 pack .vpane.lower.diff.header.path -fill x
2967 set ctxm .vpane.lower.diff.header.ctxm
2968 menu $ctxm -tearoff 0
2979 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2980 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
2984 frame .vpane.lower.diff.body
2985 set ui_diff .vpane.lower.diff.body.t
2986 text $ui_diff -background white -borderwidth 0 \
2987 -width 80 -height 15 -wrap none \
2989 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2990 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2992 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2993 -command [list $ui_diff xview]
2994 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2995 -command [list $ui_diff yview]
2996 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2997 pack .vpane.lower.diff.body.sby -side right -fill y
2998 pack $ui_diff -side left -fill both -expand 1
2999 pack .vpane.lower.diff.header -side top -fill x
3000 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3002 $ui_diff tag conf d_@ -font font_diffbold
3003 $ui_diff tag conf d_+ -foreground blue
3004 $ui_diff tag conf d_- -foreground red
3005 $ui_diff tag conf d_++ -foreground {#00a000}
3006 $ui_diff tag conf d_-- -foreground {#a000a0}
3007 $ui_diff tag conf d_+- \
3009 -background {light goldenrod yellow}
3010 $ui_diff tag conf d_-+ \
3014 # -- Diff Body Context Menu
3016 set ctxm .vpane.lower.diff.body.ctxm
3017 menu $ctxm -tearoff 0
3021 -command {tk_textCopy $ui_diff}
3022 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3024 -label {Select All} \
3026 -command {$ui_diff tag add sel 0.0 end}
3027 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3032 $ui_diff tag add sel 0.0 end
3033 tk_textCopy $ui_diff
3034 $ui_diff tag remove sel 0.0 end
3036 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3039 -label {Decrease Font Size} \
3041 -command {incr_font_size font_diff -1}
3042 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3044 -label {Increase Font Size} \
3046 -command {incr_font_size font_diff 1}
3047 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3050 -label {Show Less Context} \
3052 -command {if {$repo_config(gui.diffcontext) >= 2} {
3053 incr repo_config(gui.diffcontext) -1
3056 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3058 -label {Show More Context} \
3061 incr repo_config(gui.diffcontext)
3064 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3066 $ctxm add command -label {Options...} \
3069 bind_button3 $ui_diff "tk_popup
$ctxm %X
%Y
"
3073 set ui_status_value {Initializing...}
3074 label .status -textvariable ui_status_value \
3080 pack .status -anchor w -side bottom -fill x
3085 set gm $repo_config(gui.geometry)
3086 wm geometry . [lindex $gm 0]
3087 .vpane sash place 0 \
3088 [lindex [.vpane sash coord 0] 0] \
3090 .vpane.files sash place 0 \
3092 [lindex [.vpane.files sash coord 0] 1]
3098 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3099 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3100 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3101 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3102 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3103 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3104 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3105 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3106 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3107 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3108 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3110 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3111 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3112 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3113 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3114 bind $ui_diff <$M1B-Key-v> {break}
3115 bind $ui_diff <$M1B-Key-V> {break}
3116 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3117 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3118 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3119 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3120 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3121 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3123 bind . <Destroy> do_quit
3124 bind all <Key-F5> do_rescan
3125 bind all <$M1B-Key-r> do_rescan
3126 bind all <$M1B-Key-R> do_rescan
3127 bind . <$M1B-Key-s> do_signoff
3128 bind . <$M1B-Key-S> do_signoff
3129 bind . <$M1B-Key-i> do_include_all
3130 bind . <$M1B-Key-I> do_include_all
3131 bind . <$M1B-Key-Return> do_commit
3132 bind all <$M1B-Key-q> do_quit
3133 bind all <$M1B-Key-Q> do_quit
3134 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3135 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3136 foreach i [list $ui_index $ui_other] {
3137 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
3138 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
3139 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
3143 set file_lists($ui_index) [list]
3144 set file_lists($ui_other) [list]
3151 set selected_commit_type new
3153 wm title . "$appname ([file normalize
[file dirname $gitdir]])"
3154 focus -force $ui_comm
3155 if {!$single_commit} {
3157 populate_fetch_menu .mbar.fetch
3158 populate_pull_menu .mbar.pull
3159 populate_push_menu .mbar.push
3161 lock_index begin-read