2 # Tcl ignores the next line -*- tcl -*- \
6 Copyright ©
2006, 2007 Shawn Pearce
, Paul Mackerras.
8 This program is free software
; you can redistribute it and
/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation
; either version
2 of the License
, or
11 (at your option
) any later version.
13 This program is distributed
in the hope that it will be useful
,
14 but WITHOUT ANY WARRANTY
; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License
for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program
; if not
, write to the Free Software
20 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}
22 set appvers
{@@GIT_VERSION@@
}
23 set appname
[lindex
[file split $argv0] end
]
26 ######################################################################
30 proc is_many_config
{name
} {
31 switch
-glob -- $name {
40 proc load_config
{include_global
} {
41 global repo_config global_config default_config
43 array
unset global_config
44 if {$include_global} {
46 set fd_rc
[open
"| git repo-config --global --list" r
]
47 while {[gets
$fd_rc line
] >= 0} {
48 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
49 if {[is_many_config
$name]} {
50 lappend global_config
($name) $value
52 set global_config
($name) $value
60 array
unset repo_config
62 set fd_rc
[open
"| git repo-config --list" r
]
63 while {[gets
$fd_rc line
] >= 0} {
64 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
65 if {[is_many_config
$name]} {
66 lappend repo_config
($name) $value
68 set repo_config
($name) $value
75 foreach name
[array names default_config
] {
76 if {[catch
{set v
$global_config($name)}]} {
77 set global_config
($name) $default_config($name)
79 if {[catch
{set v
$repo_config($name)}]} {
80 set repo_config
($name) $default_config($name)
86 global default_config font_descs
87 global repo_config global_config
88 global repo_config_new global_config_new
90 foreach option
$font_descs {
91 set name
[lindex
$option 0]
92 set font
[lindex
$option 1]
93 font configure
$font \
94 -family $global_config_new(gui.
$font^^family
) \
95 -size $global_config_new(gui.
$font^^size
)
96 font configure
${font}bold \
97 -family $global_config_new(gui.
$font^^family
) \
98 -size $global_config_new(gui.
$font^^size
)
99 set global_config_new
(gui.
$name) [font configure
$font]
100 unset global_config_new
(gui.
$font^^family
)
101 unset global_config_new
(gui.
$font^^size
)
104 foreach name
[array names default_config
] {
105 set value
$global_config_new($name)
106 if {$value ne
$global_config($name)} {
107 if {$value eq
$default_config($name)} {
108 catch
{exec git repo-config
--global --unset $name}
110 regsub
-all "\[{}\]" $value {"} value
111 exec git repo-config --global $name $value
113 set global_config($name) $value
114 if {$value eq $repo_config($name)} {
115 catch {exec git repo-config --unset $name}
116 set repo_config($name) $value
121 foreach name [array names default_config] {
122 set value $repo_config_new($name)
123 if {$value ne $repo_config($name)} {
124 if {$value eq $global_config($name)} {
125 catch {exec git repo-config --unset $name}
127 regsub -all "\
[{}\
]" $value {"} value
128 exec git repo-config
$name $value
130 set repo_config
($name) $value
135 proc error_popup
{msg
} {
136 global gitdir appname
141 append title
[lindex \
142 [file split [file normalize
[file dirname $gitdir]]] \
146 set cmd
[list tk_messageBox \
149 -title "$title: error" \
151 if {[winfo ismapped .
]} {
152 lappend cmd
-parent .
157 proc warn_popup
{msg
} {
158 global gitdir appname
163 append title
[lindex \
164 [file split [file normalize
[file dirname $gitdir]]] \
168 set cmd
[list tk_messageBox \
171 -title "$title: warning" \
173 if {[winfo ismapped .
]} {
174 lappend cmd
-parent .
179 proc info_popup
{msg
} {
180 global gitdir appname
185 append title
[lindex \
186 [file split [file normalize
[file dirname $gitdir]]] \
198 ######################################################################
202 if { [catch
{set gitdir
$env(GIT_DIR
)}]
203 && [catch
{set gitdir
[exec git rev-parse
--git-dir]} err
]} {
204 catch
{wm withdraw .
}
205 error_popup
"Cannot find the git directory:\n\n$err"
208 if {![file isdirectory
$gitdir]} {
209 catch
{wm withdraw .
}
210 error_popup
"Git directory not found:\n\n$gitdir"
213 if {[lindex
[file split $gitdir] end
] ne
{.git
}} {
214 catch
{wm withdraw .
}
215 error_popup
"Cannot use funny .git directory:\n\n$gitdir"
218 if {[catch
{cd [file dirname $gitdir]} err
]} {
219 catch
{wm withdraw .
}
220 error_popup
"No working directory [file dirname $gitdir]:\n\n$err"
225 if {$appname eq
{git-citool
}} {
229 ######################################################################
237 set disable_on_lock
[list
]
238 set index_lock_type none
240 proc lock_index
{type} {
241 global index_lock_type disable_on_lock
243 if {$index_lock_type eq
{none
}} {
244 set index_lock_type
$type
245 foreach w
$disable_on_lock {
246 uplevel
#0 $w disabled
249 } elseif
{$index_lock_type eq
"begin-$type"} {
250 set index_lock_type
$type
256 proc unlock_index
{} {
257 global index_lock_type disable_on_lock
259 set index_lock_type none
260 foreach w
$disable_on_lock {
265 ######################################################################
269 proc repository_state
{ctvar hdvar mhvar
} {
270 global gitdir current_branch
271 upvar
$ctvar ct
$hdvar hd
$mhvar mh
275 if {[catch
{set current_branch
[exec git symbolic-ref HEAD
]}]} {
276 set current_branch
{}
278 regsub ^refs
/((heads|tags|remotes
)/)? \
284 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
290 set merge_head
[file join $gitdir MERGE_HEAD
]
291 if {[file exists
$merge_head]} {
293 set fd_mh
[open
$merge_head r
]
294 while {[gets
$fd_mh line
] >= 0} {
305 global PARENT empty_tree
307 set p
[lindex
$PARENT 0]
311 if {$empty_tree eq
{}} {
312 set empty_tree
[exec git mktree
<< {}]
317 proc rescan
{after
} {
318 global HEAD PARENT MERGE_HEAD commit_type
319 global ui_index ui_other ui_status_value ui_comm
320 global rescan_active file_states
323 if {$rescan_active > 0 ||
![lock_index
read]} return
325 repository_state newType newHEAD newMERGE_HEAD
326 if {[string match amend
* $commit_type]
327 && $newType eq
{normal
}
328 && $newHEAD eq
$HEAD} {
332 set MERGE_HEAD
$newMERGE_HEAD
333 set commit_type
$newType
336 array
unset file_states
338 if {![$ui_comm edit modified
]
339 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
340 if {[load_message GITGUI_MSG
]} {
341 } elseif
{[load_message MERGE_MSG
]} {
342 } elseif
{[load_message SQUASH_MSG
]} {
345 $ui_comm edit modified false
348 if {$repo_config(gui.trustmtime
) eq
{true
}} {
349 rescan_stage2
{} $after
352 set ui_status_value
{Refreshing
file status...
}
353 set cmd
[list git update-index
]
355 lappend cmd
--unmerged
356 lappend cmd
--ignore-missing
357 lappend cmd
--refresh
358 set fd_rf
[open
"| $cmd" r
]
359 fconfigure
$fd_rf -blocking 0 -translation binary
360 fileevent
$fd_rf readable \
361 [list rescan_stage2
$fd_rf $after]
365 proc rescan_stage2
{fd after
} {
366 global gitdir ui_status_value
367 global rescan_active buf_rdi buf_rdf buf_rlo
371 if {![eof
$fd]} return
375 set ls_others
[list | git ls-files
--others -z \
376 --exclude-per-directory=.gitignore
]
377 set info_exclude
[file join $gitdir info exclude
]
378 if {[file readable
$info_exclude]} {
379 lappend ls_others
"--exclude-from=$info_exclude"
387 set ui_status_value
{Scanning
for modified files ...
}
388 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
389 set fd_df
[open
"| git diff-files -z" r
]
390 set fd_lo
[open
$ls_others r
]
392 fconfigure
$fd_di -blocking 0 -translation binary
393 fconfigure
$fd_df -blocking 0 -translation binary
394 fconfigure
$fd_lo -blocking 0 -translation binary
395 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
396 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
397 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
400 proc load_message
{file} {
401 global gitdir ui_comm
403 set f
[file join $gitdir $file]
404 if {[file isfile
$f]} {
405 if {[catch
{set fd
[open
$f r
]}]} {
408 set content
[string trim
[read $fd]]
410 $ui_comm delete
0.0 end
411 $ui_comm insert end
$content
417 proc read_diff_index
{fd after
} {
420 append buf_rdi
[read $fd]
422 set n
[string length
$buf_rdi]
424 set z1
[string first
"\0" $buf_rdi $c]
427 set z2
[string first
"\0" $buf_rdi $z1]
431 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
433 [string range
$buf_rdi $z1 [expr {$z2 - 1}]] \
435 [list
[lindex
$i 0] [lindex
$i 2]] \
441 set buf_rdi
[string range
$buf_rdi $c end
]
446 rescan_done
$fd buf_rdi
$after
449 proc read_diff_files
{fd after
} {
452 append buf_rdf
[read $fd]
454 set n
[string length
$buf_rdf]
456 set z1
[string first
"\0" $buf_rdf $c]
459 set z2
[string first
"\0" $buf_rdf $z1]
463 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
465 [string range
$buf_rdf $z1 [expr {$z2 - 1}]] \
468 [list
[lindex
$i 0] [lindex
$i 2]]
473 set buf_rdf
[string range
$buf_rdf $c end
]
478 rescan_done
$fd buf_rdf
$after
481 proc read_ls_others
{fd after
} {
484 append buf_rlo
[read $fd]
485 set pck
[split $buf_rlo "\0"]
486 set buf_rlo
[lindex
$pck end
]
487 foreach p
[lrange
$pck 0 end-1
] {
490 rescan_done
$fd buf_rlo
$after
493 proc rescan_done
{fd buf after
} {
495 global file_states repo_config
498 if {![eof
$fd]} return
501 if {[incr rescan_active
-1] > 0} return
507 if {$repo_config(gui.partialinclude
) ne
{true
}} {
509 foreach path
[array names file_states
] {
510 switch
-- [lindex
$file_states($path) 0] {
512 M?
{lappend pathList
$path}
515 if {$pathList ne
{}} {
517 "Updating included files" \
519 [concat
{reshow_diff
;} $after]
528 proc prune_selection
{} {
529 global file_states selected_paths
531 foreach path
[array names selected_paths
] {
532 if {[catch
{set still_here
$file_states($path)}]} {
533 unset selected_paths
($path)
538 ######################################################################
543 global ui_diff current_diff ui_index ui_other
545 $ui_diff conf
-state normal
546 $ui_diff delete
0.0 end
547 $ui_diff conf
-state disabled
551 $ui_index tag remove in_diff
0.0 end
552 $ui_other tag remove in_diff
0.0 end
555 proc reshow_diff
{} {
556 global current_diff ui_status_value file_states
558 if {$current_diff eq
{}
559 ||
[catch
{set s
$file_states($current_diff)}]} {
562 show_diff
$current_diff
566 proc handle_empty_diff
{} {
567 global current_diff file_states file_lists
569 set path
$current_diff
570 set s
$file_states($path)
571 if {[lindex
$s 0] ne
{_M
}} return
573 info_popup
"No differences detected.
575 [short_path $path] has no changes.
577 The modification date of this file was updated
578 by another application and you currently have
579 the Trust File Modification Timestamps option
580 enabled, so Git did not automatically detect
581 that there are no content differences in this
584 This file will now be removed from the modified
585 files list, to prevent possible confusion.
587 if {[catch
{exec git update-index
-- $path} err
]} {
588 error_popup
"Failed to refresh index:\n\n$err"
592 set old_w
[mapcol
[lindex
$file_states($path) 0] $path]
593 set lno
[lsearch
-sorted $file_lists($old_w) $path]
595 set file_lists
($old_w) \
596 [lreplace
$file_lists($old_w) $lno $lno]
598 $old_w conf
-state normal
599 $old_w delete
$lno.0 [expr {$lno + 1}].0
600 $old_w conf
-state disabled
604 proc show_diff
{path
{w
{}} {lno
{}}} {
605 global file_states file_lists
606 global is_3way_diff diff_active repo_config
607 global ui_diff current_diff ui_status_value
609 if {$diff_active ||
![lock_index
read]} return
612 if {$w eq
{} ||
$lno == {}} {
613 foreach w
[array names file_lists
] {
614 set lno
[lsearch
-sorted $file_lists($w) $path]
621 if {$w ne
{} && $lno >= 1} {
622 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
625 set s
$file_states($path)
629 set current_diff
$path
630 set ui_status_value
"Loading diff of [escape_path $path]..."
632 set cmd
[list | git diff-index
]
633 lappend cmd
--no-color
634 if {$repo_config(gui.diffcontext
) > 0} {
635 lappend cmd
"-U$repo_config(gui.diffcontext)"
645 set fd
[open
$path r
]
646 set content
[read $fd]
651 set ui_status_value
"Unable to display [escape_path $path]"
652 error_popup
"Error loading file:\n\n$err"
655 $ui_diff conf
-state normal
656 $ui_diff insert end
$content
657 $ui_diff conf
-state disabled
660 set ui_status_value
{Ready.
}
669 if {[catch
{set fd
[open
$cmd r
]} err
]} {
672 set ui_status_value
"Unable to display [escape_path $path]"
673 error_popup
"Error loading diff:\n\n$err"
677 fconfigure
$fd -blocking 0 -translation auto
678 fileevent
$fd readable
[list read_diff
$fd]
681 proc read_diff
{fd
} {
682 global ui_diff ui_status_value is_3way_diff diff_active
685 $ui_diff conf
-state normal
686 while {[gets
$fd line
] >= 0} {
687 # -- Cleanup uninteresting diff header lines.
689 if {[string match
{diff --git *} $line]} continue
690 if {[string match
{diff --combined *} $line]} continue
691 if {[string match
{--- *} $line]} continue
692 if {[string match
{+++ *} $line]} continue
693 if {$line eq
{deleted
file mode
120000}} {
694 set line
"deleted symlink"
697 # -- Automatically detect if this is a 3 way diff.
699 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
701 # -- Reformat a 3 way diff, 'cause its too weird.
704 set op
[string range
$line 0 1]
707 {++} {set tags d_
+ ; set op
{ +}}
708 {--} {set tags d_-
; set op
{ -}}
709 { +} {set tags d_
++; set op
{++}}
710 { -} {set tags d_--
; set op
{--}}
711 {+ } {set tags d_-
+; set op
{-+}}
712 {- } {set tags d_
+-; set op
{+-}}
713 default
{set tags
{}}
715 set line
[string replace
$line 0 1 $op]
717 switch
-- [string index
$line 0] {
721 default
{set tags
{}}
724 $ui_diff insert end
$line $tags
725 $ui_diff insert end
"\n" $tags
727 $ui_diff conf
-state disabled
733 set ui_status_value
{Ready.
}
735 if {$repo_config(gui.trustmtime
) eq
{true
}
736 && [$ui_diff index end
] eq
{2.0}} {
742 ######################################################################
746 proc load_last_commit
{} {
747 global HEAD PARENT MERGE_HEAD commit_type ui_comm
749 if {[llength
$PARENT] == 0} {
750 error_popup
{There is nothing to amend.
752 You are about to create the initial commit.
753 There is no commit before this to amend.
758 repository_state curType curHEAD curMERGE_HEAD
759 if {$curType eq
{merge
}} {
760 error_popup
{Cannot amend
while merging.
762 You are currently
in the middle of a merge that
763 has not been fully completed. You cannot amend
764 the prior commit unless you first abort the
765 current merge activity.
773 set fd
[open
"| git cat-file commit $curHEAD" r
]
774 while {[gets
$fd line
] > 0} {
775 if {[string match
{parent
*} $line]} {
776 lappend parents
[string range
$line 7 end
]
779 set msg
[string trim
[read $fd]]
782 error_popup
"Error loading commit data for amend:\n\n$err"
788 set MERGE_HEAD
[list
]
789 switch
-- [llength
$parents] {
790 0 {set commit_type amend-initial
}
791 1 {set commit_type amend
}
792 default
{set commit_type amend-merge
}
795 $ui_comm delete
0.0 end
796 $ui_comm insert end
$msg
798 $ui_comm edit modified false
799 rescan
{set ui_status_value
{Ready.
}}
802 proc create_new_commit
{} {
803 global commit_type ui_comm
805 set commit_type normal
806 $ui_comm delete
0.0 end
808 $ui_comm edit modified false
809 rescan
{set ui_status_value
{Ready.
}}
812 set GIT_COMMITTER_IDENT
{}
814 proc committer_ident
{} {
815 global GIT_COMMITTER_IDENT
817 if {$GIT_COMMITTER_IDENT eq
{}} {
818 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
819 error_popup
"Unable to obtain your identity:\n\n$err"
822 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
823 $me me GIT_COMMITTER_IDENT
]} {
824 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
829 return $GIT_COMMITTER_IDENT
832 proc commit_tree
{} {
833 global HEAD commit_type file_states ui_comm repo_config
835 if {![lock_index update
]} return
836 if {[committer_ident
] eq
{}} return
838 # -- Our in memory state should match the repository.
840 repository_state curType curHEAD curMERGE_HEAD
841 if {[string match amend
* $commit_type]
842 && $curType eq
{normal
}
843 && $curHEAD eq
$HEAD} {
844 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
845 info_popup
{Last scanned state does not match repository state.
847 Another Git program has modified this repository
848 since the last scan. A rescan must be performed
849 before another commit can be created.
851 The rescan will be automatically started now.
854 rescan
{set ui_status_value
{Ready.
}}
858 # -- At least one file should differ in the index.
861 foreach path
[array names file_states
] {
862 switch
-glob -- [lindex
$file_states($path) 0] {
866 M?
{set files_ready
1; break}
868 error_popup
"Unmerged files cannot be committed.
870 File [short_path $path] has merge conflicts.
871 You must resolve them and include the file before committing.
877 error_popup
"Unknown file state [lindex $s 0] detected.
879 File [short_path $path] cannot be committed by this program.
885 error_popup
{No included files to commit.
887 You must include
at least
1 file before you can commit.
893 # -- A message is required.
895 set msg
[string trim
[$ui_comm get
1.0 end
]]
897 error_popup
{Please supply a commit message.
899 A good commit message has the following format
:
901 - First line
: Describe
in one sentance what you did.
903 - Remaining lines
: Describe why this change is good.
909 # -- Update included files if partialincludes are off.
911 if {$repo_config(gui.partialinclude
) ne
{true
}} {
913 foreach path
[array names file_states
] {
914 switch
-glob -- [lindex
$file_states($path) 0] {
916 M?
{lappend pathList
$path}
919 if {$pathList ne
{}} {
922 "Updating included files" \
924 [concat
{lock_index update
;} \
925 [list commit_prehook
$curHEAD $msg]]
930 commit_prehook
$curHEAD $msg
933 proc commit_prehook
{curHEAD msg
} {
934 global gitdir ui_status_value pch_error
936 set pchook
[file join $gitdir hooks pre-commit
]
938 # On Cygwin [file executable] might lie so we need to ask
939 # the shell if the hook is executable. Yes that's annoying.
941 if {[is_Windows
] && [file isfile
$pchook]} {
942 set pchook
[list sh
-c [concat \
943 "if test -x \"$pchook\";" \
944 "then exec \"$pchook\" 2>&1;" \
946 } elseif
{[file executable
$pchook]} {
947 set pchook
[list
$pchook |
& cat]
949 commit_writetree
$curHEAD $msg
953 set ui_status_value
{Calling pre-commit hook...
}
955 set fd_ph
[open
"| $pchook" r
]
956 fconfigure
$fd_ph -blocking 0 -translation binary
957 fileevent
$fd_ph readable \
958 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
961 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
962 global pch_error ui_status_value
964 append pch_error
[read $fd_ph]
965 fconfigure
$fd_ph -blocking 1
967 if {[catch
{close
$fd_ph}]} {
968 set ui_status_value
{Commit declined by pre-commit hook.
}
969 hook_failed_popup pre-commit
$pch_error
972 commit_writetree
$curHEAD $msg
977 fconfigure
$fd_ph -blocking 0
980 proc commit_writetree
{curHEAD msg
} {
981 global ui_status_value
983 set ui_status_value
{Committing changes...
}
984 set fd_wt
[open
"| git write-tree" r
]
985 fileevent
$fd_wt readable \
986 [list commit_committree
$fd_wt $curHEAD $msg]
989 proc commit_committree
{fd_wt curHEAD msg
} {
990 global HEAD PARENT MERGE_HEAD commit_type
991 global single_commit gitdir
992 global ui_status_value ui_comm selected_commit_type
993 global file_states selected_paths rescan_active
996 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
997 error_popup
"write-tree failed:\n\n$err"
998 set ui_status_value
{Commit failed.
}
1003 # -- Create the commit.
1005 set cmd
[list git commit-tree
$tree_id]
1006 set parents
[concat
$PARENT $MERGE_HEAD]
1007 if {[llength
$parents] > 0} {
1008 foreach p
$parents {
1012 # git commit-tree writes to stderr during initial commit.
1013 lappend cmd
2>/dev
/null
1016 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1017 error_popup
"commit-tree failed:\n\n$err"
1018 set ui_status_value
{Commit failed.
}
1023 # -- Update the HEAD ref.
1026 if {$commit_type ne
{normal
}} {
1027 append reflogm
" ($commit_type)"
1029 set i
[string first
"\n" $msg]
1031 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1033 append reflogm
{: } $msg
1035 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1036 if {[catch
{eval exec $cmd} err
]} {
1037 error_popup
"update-ref failed:\n\n$err"
1038 set ui_status_value
{Commit failed.
}
1043 # -- Cleanup after ourselves.
1045 catch
{file delete
[file join $gitdir MERGE_HEAD
]}
1046 catch
{file delete
[file join $gitdir MERGE_MSG
]}
1047 catch
{file delete
[file join $gitdir SQUASH_MSG
]}
1048 catch
{file delete
[file join $gitdir GITGUI_MSG
]}
1050 # -- Let rerere do its thing.
1052 if {[file isdirectory
[file join $gitdir rr-cache
]]} {
1053 catch
{exec git rerere
}
1056 # -- Run the post-commit hook.
1058 set pchook
[file join $gitdir hooks post-commit
]
1059 if {[is_Windows
] && [file isfile
$pchook]} {
1060 set pchook
[list sh
-c [concat \
1061 "if test -x \"$pchook\";" \
1062 "then exec \"$pchook\";" \
1064 } elseif
{![file executable
$pchook]} {
1067 if {$pchook ne
{}} {
1068 catch
{exec $pchook &}
1071 $ui_comm delete
0.0 end
1073 $ui_comm edit modified false
1075 if {$single_commit} do_quit
1077 # -- Update in memory status
1079 set selected_commit_type new
1080 set commit_type normal
1083 set MERGE_HEAD
[list
]
1085 foreach path
[array names file_states
] {
1086 set s
$file_states($path)
1088 switch
-glob -- $m {
1096 unset file_states
($path)
1097 catch
{unset selected_paths
($path)}
1100 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1107 set file_states
($path) [list \
1108 _
[string index
$m 1] \
1119 set ui_status_value \
1120 "Changes committed as [string range $cmt_id 0 7]."
1123 ######################################################################
1127 proc fetch_from
{remote
} {
1128 set w
[new_console
"fetch $remote" \
1129 "Fetching new changes from $remote"]
1130 set cmd
[list git fetch
]
1132 console_exec
$w $cmd
1135 proc pull_remote
{remote branch
} {
1136 global HEAD commit_type file_states repo_config
1138 if {![lock_index update
]} return
1140 # -- Our in memory state should match the repository.
1142 repository_state curType curHEAD curMERGE_HEAD
1143 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1144 info_popup
{Last scanned state does not match repository state.
1146 Another Git program has modified this repository
1147 since the last scan. A rescan must be performed
1148 before a pull operation can be started.
1150 The rescan will be automatically started now.
1153 rescan
{set ui_status_value
{Ready.
}}
1157 # -- No differences should exist before a pull.
1159 if {[array size file_states
] != 0} {
1160 error_popup
{Uncommitted but modified files are present.
1162 You should not perform a pull with unmodified
1163 files
in your working directory as Git will be
1164 unable to recover from an incorrect merge.
1166 You should commit or revert all changes before
1167 starting a pull operation.
1173 set w
[new_console
"pull $remote $branch" \
1174 "Pulling new changes from branch $branch in $remote"]
1175 set cmd
[list git pull
]
1176 if {$repo_config(gui.pullsummary
) eq
{false
}} {
1177 lappend cmd
--no-summary
1181 console_exec
$w $cmd [list post_pull_remote
$remote $branch]
1184 proc post_pull_remote
{remote branch success
} {
1185 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1186 global ui_status_value
1190 repository_state commit_type HEAD MERGE_HEAD
1192 set selected_commit_type new
1193 set ui_status_value
"Pulling $branch from $remote complete."
1195 rescan
[list
set ui_status_value \
1196 "Conflicts detected while pulling $branch from $remote."]
1200 proc push_to
{remote
} {
1201 set w
[new_console
"push $remote" \
1202 "Pushing changes to $remote"]
1203 set cmd
[list git push
]
1205 console_exec
$w $cmd
1208 ######################################################################
1212 proc mapcol
{state path
} {
1213 global all_cols ui_other
1215 if {[catch
{set r
$all_cols($state)}]} {
1216 puts
"error: no column for state={$state} $path"
1222 proc mapicon
{state path
} {
1225 if {[catch
{set r
$all_icons($state)}]} {
1226 puts
"error: no icon for state={$state} $path"
1232 proc mapdesc
{state path
} {
1235 if {[catch
{set r
$all_descs($state)}]} {
1236 puts
"error: no desc for state={$state} $path"
1242 proc escape_path
{path
} {
1243 regsub
-all "\n" $path "\\n" path
1247 proc short_path
{path
} {
1248 return [escape_path
[lindex
[file split $path] end
]]
1252 set null_sha1
[string repeat
0 40]
1254 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1255 global file_states next_icon_id null_sha1
1257 set s0
[string index
$new_state 0]
1258 set s1
[string index
$new_state 1]
1260 if {[catch
{set info
$file_states($path)}]} {
1262 set icon n
[incr next_icon_id
]
1264 set state
[lindex
$info 0]
1265 set icon
[lindex
$info 1]
1266 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1267 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1270 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1271 elseif
{$s0 eq
{_
}} {set s0 _
}
1273 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1274 elseif
{$s1 eq
{_
}} {set s1 _
}
1276 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1277 set head_info
[list
0 $null_sha1]
1278 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1279 && $head_info eq
{}} {
1280 set head_info
$index_info
1283 set file_states
($path) [list
$s0$s1 $icon \
1284 $head_info $index_info \
1289 proc display_file
{path state
} {
1290 global file_states file_lists selected_paths
1292 set old_m
[merge_state
$path $state]
1293 set s
$file_states($path)
1294 set new_m
[lindex
$s 0]
1295 set new_w
[mapcol
$new_m $path]
1296 set old_w
[mapcol
$old_m $path]
1297 set new_icon
[mapicon
$new_m $path]
1299 if {$new_m eq
{__
}} {
1300 set lno
[lsearch
-sorted $file_lists($old_w) $path]
1302 set file_lists
($old_w) \
1303 [lreplace
$file_lists($old_w) $lno $lno]
1305 $old_w conf
-state normal
1306 $old_w delete
$lno.0 [expr {$lno + 1}].0
1307 $old_w conf
-state disabled
1309 unset file_states
($path)
1310 catch
{unset selected_paths
($path)}
1314 if {$new_w ne
$old_w} {
1315 set lno
[lsearch
-sorted $file_lists($old_w) $path]
1317 set file_lists
($old_w) \
1318 [lreplace
$file_lists($old_w) $lno $lno]
1320 $old_w conf
-state normal
1321 $old_w delete
$lno.0 [expr {$lno + 1}].0
1322 $old_w conf
-state disabled
1325 lappend file_lists
($new_w) $path
1326 set file_lists
($new_w) [lsort
$file_lists($new_w)]
1327 set lno
[lsearch
-sorted $file_lists($new_w) $path]
1329 $new_w conf
-state normal
1330 $new_w image create
$lno.0 \
1331 -align center
-padx 5 -pady 1 \
1332 -name [lindex
$s 1] \
1334 $new_w insert
$lno.1 "[escape_path $path]\n"
1335 if {[catch
{set in_sel
$selected_paths($path)}]} {
1339 $new_w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1341 $new_w conf
-state disabled
1342 } elseif
{$new_icon ne
[mapicon
$old_m $path]} {
1343 $new_w conf
-state normal
1344 $new_w image conf
[lindex
$s 1] -image $new_icon
1345 $new_w conf
-state disabled
1349 proc display_all_files
{} {
1350 global ui_index ui_other
1351 global file_states file_lists
1352 global last_clicked selected_paths
1354 $ui_index conf
-state normal
1355 $ui_other conf
-state normal
1357 $ui_index delete
0.0 end
1358 $ui_other delete
0.0 end
1361 set file_lists
($ui_index) [list
]
1362 set file_lists
($ui_other) [list
]
1364 foreach path
[lsort
[array names file_states
]] {
1365 set s
$file_states($path)
1367 set w
[mapcol
$m $path]
1368 lappend file_lists
($w) $path
1369 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1370 $w image create end \
1371 -align center
-padx 5 -pady 1 \
1372 -name [lindex
$s 1] \
1373 -image [mapicon
$m $path]
1374 $w insert end
"[escape_path $path]\n"
1375 if {[catch
{set in_sel
$selected_paths($path)}]} {
1379 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1383 $ui_index conf
-state disabled
1384 $ui_other conf
-state disabled
1387 proc update_indexinfo
{msg pathList after
} {
1388 global update_index_cp ui_status_value
1390 if {![lock_index update
]} return
1392 set update_index_cp
0
1393 set pathList
[lsort
$pathList]
1394 set totalCnt
[llength
$pathList]
1395 set batch [expr {int
($totalCnt * .01) + 1}]
1396 if {$batch > 25} {set batch 25}
1398 set ui_status_value
[format \
1399 "$msg... %i/%i files (%.2f%%)" \
1403 set fd
[open
"| git update-index -z --index-info" w
]
1409 fileevent
$fd writable
[list \
1410 write_update_indexinfo \
1420 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1421 global update_index_cp ui_status_value
1422 global file_states current_diff
1424 if {$update_index_cp >= $totalCnt} {
1431 for {set i
$batch} \
1432 {$update_index_cp < $totalCnt && $i > 0} \
1434 set path
[lindex
$pathList $update_index_cp]
1435 incr update_index_cp
1437 set s
$file_states($path)
1438 switch
-glob -- [lindex
$s 0] {
1445 set info
[lindex
$s 2]
1446 if {$info eq
{}} continue
1448 puts
-nonewline $fd $info
1449 puts
-nonewline $fd "\t"
1450 puts
-nonewline $fd $path
1451 puts
-nonewline $fd "\0"
1452 display_file
$path $new
1455 set ui_status_value
[format \
1456 "$msg... %i/%i files (%.2f%%)" \
1459 [expr {100.0 * $update_index_cp / $totalCnt}]]
1462 proc update_index
{msg pathList after
} {
1463 global update_index_cp ui_status_value
1465 if {![lock_index update
]} return
1467 set update_index_cp
0
1468 set pathList
[lsort
$pathList]
1469 set totalCnt
[llength
$pathList]
1470 set batch [expr {int
($totalCnt * .01) + 1}]
1471 if {$batch > 25} {set batch 25}
1473 set ui_status_value
[format \
1474 "$msg... %i/%i files (%.2f%%)" \
1478 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1484 fileevent
$fd writable
[list \
1485 write_update_index \
1495 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1496 global update_index_cp ui_status_value
1497 global file_states current_diff
1499 if {$update_index_cp >= $totalCnt} {
1506 for {set i
$batch} \
1507 {$update_index_cp < $totalCnt && $i > 0} \
1509 set path
[lindex
$pathList $update_index_cp]
1510 incr update_index_cp
1512 switch
-glob -- [lindex
$file_states($path) 0] {
1531 puts
-nonewline $fd $path
1532 puts
-nonewline $fd "\0"
1533 display_file
$path $new
1536 set ui_status_value
[format \
1537 "$msg... %i/%i files (%.2f%%)" \
1540 [expr {100.0 * $update_index_cp / $totalCnt}]]
1543 proc checkout_index
{msg pathList after
} {
1544 global update_index_cp ui_status_value
1546 if {![lock_index update
]} return
1548 set update_index_cp
0
1549 set pathList
[lsort
$pathList]
1550 set totalCnt
[llength
$pathList]
1551 set batch [expr {int
($totalCnt * .01) + 1}]
1552 if {$batch > 25} {set batch 25}
1554 set ui_status_value
[format \
1555 "$msg... %i/%i files (%.2f%%)" \
1559 set cmd
[list git checkout-index
]
1565 set fd
[open
"| $cmd " w
]
1571 fileevent
$fd writable
[list \
1572 write_checkout_index \
1582 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1583 global update_index_cp ui_status_value
1584 global file_states current_diff
1586 if {$update_index_cp >= $totalCnt} {
1593 for {set i
$batch} \
1594 {$update_index_cp < $totalCnt && $i > 0} \
1596 set path
[lindex
$pathList $update_index_cp]
1597 incr update_index_cp
1599 switch
-glob -- [lindex
$file_states($path) 0] {
1609 puts
-nonewline $fd $path
1610 puts
-nonewline $fd "\0"
1611 display_file
$path $new
1614 set ui_status_value
[format \
1615 "$msg... %i/%i files (%.2f%%)" \
1618 [expr {100.0 * $update_index_cp / $totalCnt}]]
1621 ######################################################################
1623 ## branch management
1625 proc load_all_heads
{} {
1626 global all_heads tracking_branches
1628 set all_heads
[list
]
1629 set cmd
[list git for-each-ref
]
1630 lappend cmd
--format=%(refname
)
1631 lappend cmd refs
/heads
1632 set fd
[open
"| $cmd" r
]
1633 while {[gets
$fd line
] > 0} {
1634 if {![catch
{set info
$tracking_branches($line)}]} continue
1635 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1636 lappend all_heads
$name
1640 set all_heads
[lsort
$all_heads]
1643 proc populate_branch_menu
{m
} {
1644 global all_heads disable_on_lock
1647 foreach b
$all_heads {
1648 $m add radiobutton \
1650 -command [list switch_branch
$b] \
1651 -variable current_branch \
1654 lappend disable_on_lock \
1655 [list
$m entryconf
[$m index last
] -state]
1659 proc do_create_branch
{} {
1660 error
"NOT IMPLEMENTED"
1663 proc do_delete_branch
{} {
1664 error
"NOT IMPLEMENTED"
1667 proc switch_branch
{b
} {
1668 global HEAD commit_type file_states current_branch
1669 global selected_commit_type ui_comm
1671 if {![lock_index switch
]} return
1673 # -- Backup the selected branch (repository_state resets it)
1675 set new_branch
$current_branch
1677 # -- Our in memory state should match the repository.
1679 repository_state curType curHEAD curMERGE_HEAD
1680 if {[string match amend
* $commit_type]
1681 && $curType eq
{normal
}
1682 && $curHEAD eq
$HEAD} {
1683 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1684 info_popup
{Last scanned state does not match repository state.
1686 Another Git program has modified this repository
1687 since the last scan. A rescan must be performed
1688 before the current branch can be changed.
1690 The rescan will be automatically started now.
1693 rescan
{set ui_status_value
{Ready.
}}
1697 # -- Toss the message buffer if we are in amend mode.
1699 if {[string match amend
* $curType]} {
1700 $ui_comm delete
0.0 end
1702 $ui_comm edit modified false
1705 set selected_commit_type new
1706 set current_branch
$new_branch
1709 error
"NOT FINISHED"
1712 ######################################################################
1714 ## remote management
1716 proc load_all_remotes
{} {
1717 global gitdir repo_config
1718 global all_remotes tracking_branches
1720 set all_remotes
[list
]
1721 array
unset tracking_branches
1723 set rm_dir
[file join $gitdir remotes
]
1724 if {[file isdirectory
$rm_dir]} {
1725 set all_remotes
[glob \
1729 -directory $rm_dir *]
1731 foreach name
$all_remotes {
1733 set fd
[open
[file join $rm_dir $name] r
]
1734 while {[gets
$fd line
] >= 0} {
1735 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
1736 $line line src dst
]} continue
1737 if {![regexp ^refs
/ $dst]} {
1738 set dst
"refs/heads/$dst"
1740 set tracking_branches
($dst) [list
$name $src]
1747 foreach line
[array names repo_config remote.
*.url
] {
1748 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
1749 lappend all_remotes
$name
1751 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
1755 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
1756 if {![regexp ^refs
/ $dst]} {
1757 set dst
"refs/heads/$dst"
1759 set tracking_branches
($dst) [list
$name $src]
1763 set all_remotes
[lsort
-unique $all_remotes]
1766 proc populate_fetch_menu
{m
} {
1767 global gitdir all_remotes repo_config
1769 foreach r
$all_remotes {
1771 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
1772 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
1777 set fd
[open
[file join $gitdir remotes
$r] r
]
1778 while {[gets
$fd n
] >= 0} {
1779 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
1790 -label "Fetch from $r..." \
1791 -command [list fetch_from
$r] \
1797 proc populate_push_menu
{m
} {
1798 global gitdir all_remotes repo_config
1800 foreach r
$all_remotes {
1802 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
1803 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
1808 set fd
[open
[file join $gitdir remotes
$r] r
]
1809 while {[gets
$fd n
] >= 0} {
1810 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
1821 -label "Push to $r..." \
1822 -command [list push_to
$r] \
1828 proc populate_pull_menu
{m
} {
1829 global gitdir repo_config all_remotes disable_on_lock
1831 foreach remote
$all_remotes {
1833 if {[array get repo_config remote.
$remote.url
] ne
{}} {
1834 if {[array get repo_config remote.
$remote.fetch
] ne
{}} {
1835 foreach line
$repo_config(remote.
$remote.fetch
) {
1836 if {[regexp
{^
([^
:]+):} $line line rb
]} {
1843 set fd
[open
[file join $gitdir remotes
$remote] r
]
1844 while {[gets
$fd line
] >= 0} {
1845 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $line line rb
]} {
1853 foreach rb
$rb_list {
1854 regsub ^refs
/heads
/ $rb {} rb_short
1856 -label "Branch $rb_short from $remote..." \
1857 -command [list pull_remote
$remote $rb] \
1859 lappend disable_on_lock \
1860 [list
$m entryconf
[$m index last
] -state]
1865 ######################################################################
1870 #define mask_width 14
1871 #define mask_height 15
1872 static unsigned char mask_bits
[] = {
1873 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1874 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1875 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1878 image create bitmap file_plain
-background white
-foreground black
-data {
1879 #define plain_width 14
1880 #define plain_height 15
1881 static unsigned char plain_bits
[] = {
1882 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1883 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1884 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1885 } -maskdata $filemask
1887 image create bitmap file_mod
-background white
-foreground blue
-data {
1888 #define mod_width 14
1889 #define mod_height 15
1890 static unsigned char mod_bits
[] = {
1891 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1892 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1893 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1894 } -maskdata $filemask
1896 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
1897 #define file_fulltick_width 14
1898 #define file_fulltick_height 15
1899 static unsigned char file_fulltick_bits
[] = {
1900 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1901 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1902 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1903 } -maskdata $filemask
1905 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1906 #define parttick_width 14
1907 #define parttick_height 15
1908 static unsigned char parttick_bits
[] = {
1909 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1910 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1911 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1912 } -maskdata $filemask
1914 image create bitmap file_question
-background white
-foreground black
-data {
1915 #define file_question_width 14
1916 #define file_question_height 15
1917 static unsigned char file_question_bits
[] = {
1918 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1919 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1920 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1921 } -maskdata $filemask
1923 image create bitmap file_removed
-background white
-foreground red
-data {
1924 #define file_removed_width 14
1925 #define file_removed_height 15
1926 static unsigned char file_removed_bits
[] = {
1927 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1928 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1929 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1930 } -maskdata $filemask
1932 image create bitmap file_merge
-background white
-foreground blue
-data {
1933 #define file_merge_width 14
1934 #define file_merge_height 15
1935 static unsigned char file_merge_bits
[] = {
1936 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1937 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1938 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1939 } -maskdata $filemask
1941 set ui_index .vpane.files.index.list
1942 set ui_other .vpane.files.other.list
1943 set max_status_desc
0
1945 {__ i plain
"Unmodified"}
1946 {_M i mod
"Modified"}
1947 {M_ i fulltick
"Added to commit"}
1948 {MM i parttick
"Partially included"}
1949 {MD i question
"Added (but gone)"}
1951 {_O o plain
"Untracked"}
1952 {A_ o fulltick
"Added by commit"}
1953 {AM o parttick
"Partially added"}
1954 {AD o question
"Added (but gone)"}
1956 {_D i question
"Missing"}
1957 {DD i removed
"Removed by commit"}
1958 {D_ i removed
"Removed by commit"}
1959 {DO i removed
"Removed (still exists)"}
1960 {DM i removed
"Removed (but modified)"}
1962 {UD i merge
"Merge conflicts"}
1963 {UM i merge
"Merge conflicts"}
1964 {U_ i merge
"Merge conflicts"}
1966 if {$max_status_desc < [string length
[lindex
$i 3]]} {
1967 set max_status_desc
[string length
[lindex
$i 3]]
1969 if {[lindex
$i 1] eq
{i
}} {
1970 set all_cols
([lindex
$i 0]) $ui_index
1972 set all_cols
([lindex
$i 0]) $ui_other
1974 set all_icons
([lindex
$i 0]) file_
[lindex
$i 2]
1975 set all_descs
([lindex
$i 0]) [lindex
$i 3]
1979 ######################################################################
1984 global tcl_platform tk_library
1985 if {[tk windowingsystem
] eq
{aqua
}} {
1991 proc is_Windows
{} {
1993 if {$tcl_platform(platform
) eq
{windows
}} {
1999 proc bind_button3
{w cmd
} {
2000 bind $w <Any-Button-3
> $cmd
2002 bind $w <Control-Button-1
> $cmd
2006 proc incr_font_size
{font
{amt
1}} {
2007 set sz
[font configure
$font -size]
2009 font configure
$font -size $sz
2010 font configure
${font}bold
-size $sz
2013 proc hook_failed_popup
{hook msg
} {
2014 global gitdir appname
2020 label
$w.m.l1
-text "$hook hook failed:" \
2025 -background white
-borderwidth 1 \
2027 -width 80 -height 10 \
2029 -yscrollcommand [list
$w.m.sby
set]
2031 -text {You must correct the above errors before committing.
} \
2035 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2036 pack
$w.m.l1
-side top
-fill x
2037 pack
$w.m.l2
-side bottom
-fill x
2038 pack
$w.m.sby
-side right
-fill y
2039 pack
$w.m.t
-side left
-fill both
-expand 1
2040 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2042 $w.m.t insert
1.0 $msg
2043 $w.m.t conf
-state disabled
2045 button
$w.ok
-text OK \
2048 -command "destroy $w"
2049 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2051 bind $w <Visibility
> "grab $w; focus $w"
2052 bind $w <Key-Return
> "destroy $w"
2053 wm title
$w "$appname ([lindex [file split \
2054 [file normalize [file dirname $gitdir]]] \
2059 set next_console_id
0
2061 proc new_console
{short_title long_title
} {
2062 global next_console_id console_data
2063 set w .console
[incr next_console_id
]
2064 set console_data
($w) [list
$short_title $long_title]
2065 return [console_init
$w]
2068 proc console_init
{w
} {
2069 global console_cr console_data
2070 global gitdir appname M1B
2072 set console_cr
($w) 1.0
2075 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
2080 -background white
-borderwidth 1 \
2082 -width 80 -height 10 \
2085 -yscrollcommand [list
$w.m.sby
set]
2086 label
$w.m.s
-text {Working... please
wait...
} \
2090 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2091 pack
$w.m.l1
-side top
-fill x
2092 pack
$w.m.s
-side bottom
-fill x
2093 pack
$w.m.sby
-side right
-fill y
2094 pack
$w.m.t
-side left
-fill both
-expand 1
2095 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2097 menu
$w.ctxm
-tearoff 0
2098 $w.ctxm add
command -label "Copy" \
2100 -command "tk_textCopy $w.m.t"
2101 $w.ctxm add
command -label "Select All" \
2103 -command "$w.m.t tag add sel 0.0 end"
2104 $w.ctxm add
command -label "Copy All" \
2107 $w.m.t tag add sel 0.0 end
2109 $w.m.t tag remove sel 0.0 end
2112 button
$w.ok
-text {Close
} \
2115 -command "destroy $w"
2116 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2118 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
2119 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2120 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2121 bind $w <Visibility
> "focus $w"
2122 wm title
$w "$appname ([lindex [file split \
2123 [file normalize [file dirname $gitdir]]] \
2124 end]): [lindex $console_data($w) 0]"
2128 proc console_exec
{w cmd
{after
{}}} {
2129 # -- Windows tosses the enviroment when we exec our child.
2130 # But most users need that so we have to relogin. :-(
2133 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
2136 # -- Tcl won't let us redirect both stdout and stderr to
2137 # the same pipe. So pass it through cat...
2139 set cmd
[concat |
$cmd |
& cat]
2141 set fd_f
[open
$cmd r
]
2142 fconfigure
$fd_f -blocking 0 -translation binary
2143 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
2146 proc console_read
{w fd after
} {
2147 global console_cr console_data
2151 if {![winfo exists
$w]} {console_init
$w}
2152 $w.m.t conf
-state normal
2154 set n
[string length
$buf]
2156 set cr
[string first
"\r" $buf $c]
2157 set lf
[string first
"\n" $buf $c]
2158 if {$cr < 0} {set cr
[expr {$n + 1}]}
2159 if {$lf < 0} {set lf
[expr {$n + 1}]}
2162 $w.m.t insert end
[string range
$buf $c $lf]
2163 set console_cr
($w) [$w.m.t index
{end
-1c}]
2167 $w.m.t delete
$console_cr($w) end
2168 $w.m.t insert end
"\n"
2169 $w.m.t insert end
[string range
$buf $c $cr]
2174 $w.m.t conf
-state disabled
2178 fconfigure
$fd -blocking 1
2180 if {[catch
{close
$fd}]} {
2181 if {![winfo exists
$w]} {console_init
$w}
2182 $w.m.s conf
-background red
-text {Error
: Command Failed
}
2183 $w.ok conf
-state normal
2185 } elseif
{[winfo exists
$w]} {
2186 $w.m.s conf
-background green
-text {Success
}
2187 $w.ok conf
-state normal
2190 array
unset console_cr
$w
2191 array
unset console_data
$w
2193 uplevel
#0 $after $ok
2197 fconfigure
$fd -blocking 0
2200 ######################################################################
2204 set starting_gitk_msg
{Please
wait... Starting gitk...
}
2206 proc do_gitk
{revs
} {
2207 global ui_status_value starting_gitk_msg
2215 set cmd
"sh -c \"exec $cmd\""
2219 if {[catch
{eval exec $cmd} err
]} {
2220 error_popup
"Failed to start gitk:\n\n$err"
2222 set ui_status_value
$starting_gitk_msg
2224 if {$ui_status_value eq
$starting_gitk_msg} {
2225 set ui_status_value
{Ready.
}
2232 set w
[new_console
{gc
} {Compressing the object database
}]
2233 console_exec
$w {git gc
}
2236 proc do_fsck_objects
{} {
2237 set w
[new_console
{fsck-objects
} \
2238 {Verifying the object database with fsck-objects
}]
2239 set cmd
[list git fsck-objects
]
2242 lappend cmd
--strict
2243 console_exec
$w $cmd
2249 global gitdir ui_comm is_quitting repo_config commit_type
2251 if {$is_quitting} return
2254 # -- Stash our current commit buffer.
2256 set save
[file join $gitdir GITGUI_MSG
]
2257 set msg
[string trim
[$ui_comm get
0.0 end
]]
2258 if {![string match amend
* $commit_type]
2259 && [$ui_comm edit modified
]
2262 set fd
[open
$save w
]
2263 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
2267 catch
{file delete
$save}
2270 # -- Stash our current window geometry into this repository.
2272 set cfg_geometry
[list
]
2273 lappend cfg_geometry
[wm geometry .
]
2274 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
2275 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
2276 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2279 if {$cfg_geometry ne
$rc_geometry} {
2280 catch
{exec git repo-config gui.geometry
$cfg_geometry}
2287 rescan
{set ui_status_value
{Ready.
}}
2290 proc remove_helper
{txt paths
} {
2291 global file_states current_diff
2293 if {![lock_index begin-update
]} return
2297 foreach path
$paths {
2298 switch
-glob -- [lindex
$file_states($path) 0] {
2302 lappend pathList
$path
2303 if {$path eq
$current_diff} {
2304 set after
{reshow_diff
;}
2309 if {$pathList eq
{}} {
2315 [concat
$after {set ui_status_value
{Ready.
}}]
2319 proc do_remove_selection
{} {
2320 global current_diff selected_paths
2322 if {[array size selected_paths
] > 0} {
2324 {Removing selected files from commit
} \
2325 [array names selected_paths
]
2326 } elseif
{$current_diff ne
{}} {
2328 "Removing [short_path $current_diff] from commit" \
2329 [list
$current_diff]
2333 proc include_helper
{txt paths
} {
2334 global file_states current_diff
2336 if {![lock_index begin-update
]} return
2340 foreach path
$paths {
2341 switch
-glob -- [lindex
$file_states($path) 0] {
2350 lappend pathList
$path
2351 if {$path eq
$current_diff} {
2352 set after
{reshow_diff
;}
2357 if {$pathList eq
{}} {
2363 [concat
$after {set ui_status_value
{Ready to commit.
}}]
2367 proc do_include_selection
{} {
2368 global current_diff selected_paths
2370 if {[array size selected_paths
] > 0} {
2372 {Adding selected files
} \
2373 [array names selected_paths
]
2374 } elseif
{$current_diff ne
{}} {
2376 "Adding [short_path $current_diff]" \
2377 [list
$current_diff]
2381 proc do_include_all
{} {
2385 foreach path
[array names file_states
] {
2386 switch
-- [lindex
$file_states($path) 0] {
2392 _D
{lappend paths
$path}
2396 {Adding all modified files
} \
2400 proc revert_helper
{txt paths
} {
2401 global gitdir appname
2402 global file_states current_diff
2404 if {![lock_index begin-update
]} return
2408 foreach path
$paths {
2409 switch
-glob -- [lindex
$file_states($path) 0] {
2416 lappend pathList
$path
2417 if {$path eq
$current_diff} {
2418 set after
{reshow_diff
;}
2424 set n
[llength
$pathList]
2428 } elseif
{$n == 1} {
2429 set s
"[short_path [lindex $pathList]]"
2431 set s
"these $n files"
2434 set reponame
[lindex
[file split \
2435 [file normalize
[file dirname $gitdir]]] \
2438 set reply
[tk_dialog \
2440 "$appname ($reponame)" \
2441 "Revert changes in $s?
2443 Any unadded changes will be permanently lost by the revert." \
2453 [concat
$after {set ui_status_value
{Ready.
}}]
2459 proc do_revert_selection
{} {
2460 global current_diff selected_paths
2462 if {[array size selected_paths
] > 0} {
2464 {Reverting selected files
} \
2465 [array names selected_paths
]
2466 } elseif
{$current_diff ne
{}} {
2468 "Reverting [short_path $current_diff]" \
2469 [list
$current_diff]
2473 proc do_signoff
{} {
2476 set me
[committer_ident
]
2477 if {$me eq
{}} return
2479 set sob
"Signed-off-by: $me"
2480 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
2481 if {$last ne
$sob} {
2482 $ui_comm edit separator
2484 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
2485 $ui_comm insert end
"\n"
2487 $ui_comm insert end
"\n$sob"
2488 $ui_comm edit separator
2493 proc do_select_commit_type
{} {
2494 global commit_type selected_commit_type
2496 if {$selected_commit_type eq
{new
}
2497 && [string match amend
* $commit_type]} {
2499 } elseif
{$selected_commit_type eq
{amend
}
2500 && ![string match amend
* $commit_type]} {
2503 # The amend request was rejected...
2505 if {![string match amend
* $commit_type]} {
2506 set selected_commit_type new
2516 global appname appvers copyright
2517 global tcl_patchLevel tk_patchLevel
2521 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2523 label
$w.header
-text "About $appname" \
2525 pack
$w.header
-side top
-fill x
2528 button
$w.buttons.close
-text {Close
} \
2530 -command [list destroy
$w]
2531 pack
$w.buttons.close
-side right
2532 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2535 -text "$appname - a commit creation tool for Git.
2543 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
2546 append v
"$appname version $appvers\n"
2547 append v
"[exec git version]\n"
2549 if {$tcl_patchLevel eq
$tk_patchLevel} {
2550 append v
"Tcl/Tk version $tcl_patchLevel"
2552 append v
"Tcl version $tcl_patchLevel"
2553 append v
", Tk version $tk_patchLevel"
2564 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
2566 menu
$w.ctxm
-tearoff 0
2567 $w.ctxm add
command \
2572 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2575 bind $w <Visibility
> "grab $w; focus $w"
2576 bind $w <Key-Escape
> "destroy $w"
2577 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2578 wm title
$w "About $appname"
2582 proc do_options
{} {
2583 global appname gitdir font_descs
2584 global repo_config global_config
2585 global repo_config_new global_config_new
2587 array
unset repo_config_new
2588 array
unset global_config_new
2589 foreach name
[array names repo_config
] {
2590 set repo_config_new
($name) $repo_config($name)
2593 foreach name
[array names repo_config
] {
2595 gui.diffcontext
{continue}
2597 set repo_config_new
($name) $repo_config($name)
2599 foreach name
[array names global_config
] {
2600 set global_config_new
($name) $global_config($name)
2602 set reponame
[lindex
[file split \
2603 [file normalize
[file dirname $gitdir]]] \
2606 set w .options_editor
2608 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2610 label
$w.header
-text "$appname Options" \
2612 pack
$w.header
-side top
-fill x
2615 button
$w.buttons.restore
-text {Restore Defaults
} \
2617 -command do_restore_defaults
2618 pack
$w.buttons.restore
-side left
2619 button
$w.buttons.save
-text Save \
2621 -command [list do_save_config
$w]
2622 pack
$w.buttons.save
-side right
2623 button
$w.buttons.cancel
-text {Cancel
} \
2625 -command [list destroy
$w]
2626 pack
$w.buttons.cancel
-side right
2627 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2629 labelframe
$w.repo
-text "$reponame Repository" \
2631 -relief raised
-borderwidth 2
2632 labelframe
$w.global
-text {Global
(All Repositories
)} \
2634 -relief raised
-borderwidth 2
2635 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
2636 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
2639 {b partialinclude
{Allow Partially Added Files
}}
2640 {b pullsummary
{Show Pull Summary
}}
2641 {b trustmtime
{Trust File Modification Timestamps
}}
2642 {i diffcontext
{Number of Diff Context Lines
}}
2644 set type [lindex
$option 0]
2645 set name
[lindex
$option 1]
2646 set text
[lindex
$option 2]
2647 foreach f
{repo global
} {
2650 checkbutton
$w.
$f.
$name -text $text \
2651 -variable ${f}_config_new
(gui.
$name) \
2655 pack
$w.
$f.
$name -side top
-anchor w
2659 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
2660 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
2661 spinbox
$w.
$f.
$name.v \
2662 -textvariable ${f}_config_new
(gui.
$name) \
2663 -from 1 -to 99 -increment 1 \
2666 pack
$w.
$f.
$name.v
-side right
-anchor e
2667 pack
$w.
$f.
$name -side top
-anchor w
-fill x
2673 set all_fonts
[lsort
[font families
]]
2674 foreach option
$font_descs {
2675 set name
[lindex
$option 0]
2676 set font
[lindex
$option 1]
2677 set text
[lindex
$option 2]
2679 set global_config_new
(gui.
$font^^family
) \
2680 [font configure
$font -family]
2681 set global_config_new
(gui.
$font^^size
) \
2682 [font configure
$font -size]
2684 frame
$w.global.
$name
2685 label
$w.global.
$name.l
-text "$text:" -font font_ui
2686 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
2687 eval tk_optionMenu
$w.global.
$name.family \
2688 global_config_new
(gui.
$font^^family
) \
2690 spinbox
$w.global.
$name.size \
2691 -textvariable global_config_new
(gui.
$font^^size
) \
2692 -from 2 -to 80 -increment 1 \
2695 pack
$w.global.
$name.size
-side right
-anchor e
2696 pack
$w.global.
$name.family
-side right
-anchor e
2697 pack
$w.global.
$name -side top
-anchor w
-fill x
2700 bind $w <Visibility
> "grab $w; focus $w"
2701 bind $w <Key-Escape
> "destroy $w"
2702 wm title
$w "$appname ($reponame): Options"
2706 proc do_restore_defaults
{} {
2707 global font_descs default_config repo_config
2708 global repo_config_new global_config_new
2710 foreach name
[array names default_config
] {
2711 set repo_config_new
($name) $default_config($name)
2712 set global_config_new
($name) $default_config($name)
2715 foreach option
$font_descs {
2716 set name
[lindex
$option 0]
2717 set repo_config
(gui.
$name) $default_config(gui.
$name)
2721 foreach option
$font_descs {
2722 set name
[lindex
$option 0]
2723 set font
[lindex
$option 1]
2724 set global_config_new
(gui.
$font^^family
) \
2725 [font configure
$font -family]
2726 set global_config_new
(gui.
$font^^size
) \
2727 [font configure
$font -size]
2731 proc do_save_config
{w
} {
2732 if {[catch
{save_config
} err
]} {
2733 error_popup
"Failed to completely save options:\n\n$err"
2739 proc do_windows_shortcut
{} {
2740 global gitdir appname argv0
2742 set reponame
[lindex
[file split \
2743 [file normalize
[file dirname $gitdir]]] \
2747 set desktop
[exec cygpath \
2755 set fn
[tk_getSaveFile \
2757 -title "$appname ($reponame): Create Desktop Icon" \
2758 -initialdir $desktop \
2759 -initialfile "Git $reponame.bat"]
2763 set sh
[exec cygpath \
2767 set me
[exec cygpath \
2771 set gd
[exec cygpath \
2775 regsub
-all ' $me "'\\''" me
2776 regsub -all ' $gd "'\\''" gd
2777 puts $fd "@ECHO Starting git-gui... Please wait..."
2778 puts -nonewline $fd "@\"$sh\" --login -c \""
2779 puts -nonewline $fd "GIT_DIR='$gd'"
2780 puts -nonewline $fd " '$me'"
2784 error_popup "Cannot write script:\n\n$err"
2789 proc do_macosx_app {} {
2790 global gitdir appname argv0 env
2792 set reponame [lindex [file split \
2793 [file normalize [file dirname $gitdir]]] \
2796 set fn [tk_getSaveFile \
2798 -title "$appname ($reponame): Create Desktop Icon" \
2799 -initialdir [file join $env(HOME) Desktop] \
2800 -initialfile "Git $reponame.app"]
2803 set Contents [file join $fn Contents]
2804 set MacOS [file join $Contents MacOS]
2805 set exe [file join $MacOS git-gui]
2809 set fd [open [file join $Contents Info.plist] w]
2810 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2811 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2812 <plist version="1.0">
2814 <key>CFBundleDevelopmentRegion</key>
2815 <string>English</string>
2816 <key>CFBundleExecutable</key>
2817 <string>git-gui</string>
2818 <key>CFBundleIdentifier</key>
2819 <string>org.spearce.git-gui</string>
2820 <key>CFBundleInfoDictionaryVersion</key>
2821 <string>6.0</string>
2822 <key>CFBundlePackageType</key>
2823 <string>APPL</string>
2824 <key>CFBundleSignature</key>
2825 <string>????</string>
2826 <key>CFBundleVersion</key>
2827 <string>1.0</string>
2828 <key>NSPrincipalClass</key>
2829 <string>NSApplication</string>
2834 set fd [open $exe w]
2835 set gd [file normalize $gitdir]
2836 set ep [file normalize [exec git --exec-path]]
2837 regsub -all ' $gd "'\\''" gd
2838 regsub
-all ' $ep "'\\''" ep
2839 puts $fd "#!/bin/sh"
2840 foreach name
[array names env
] {
2841 if {[string match GIT_
* $name]} {
2842 regsub
-all ' $env($name) "'\\''" v
2843 puts $fd "export $name='$v'"
2846 puts $fd "export PATH
='$ep':\
$PATH"
2847 puts $fd "export GIT_DIR
='$gd'"
2848 puts $fd "exec [file normalize
$argv0]"
2851 file attributes $exe -permissions u+x,g+x,o+x
2853 error_popup "Cannot
write icon
:\n\n$err"
2858 proc toggle_or_diff {w x y} {
2859 global file_states file_lists current_diff ui_index ui_other
2860 global last_clicked selected_paths
2862 set pos [split [$w index @$x,$y] .]
2863 set lno [lindex $pos 0]
2864 set col [lindex $pos 1]
2865 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2871 set last_clicked [list $w $lno]
2872 array unset selected_paths
2873 $ui_index tag remove in_sel 0.0 end
2874 $ui_other tag remove in_sel 0.0 end
2877 if {$current_diff eq $path} {
2878 set after {reshow_diff;}
2882 switch -glob -- [lindex $file_states($path) 0] {
2889 "Removing
[short_path
$path] from commit
" \
2891 [concat $after {set ui_status_value {Ready.}}]
2895 "Adding
[short_path
$path]" \
2897 [concat $after {set ui_status_value {Ready.}}]
2901 show_diff $path $w $lno
2905 proc add_one_to_selection {w x y} {
2907 global last_clicked selected_paths
2909 set pos [split [$w index @$x,$y] .]
2910 set lno [lindex $pos 0]
2911 set col [lindex $pos 1]
2912 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2918 set last_clicked [list $w $lno]
2919 if {[catch {set in_sel $selected_paths($path)}]} {
2923 unset selected_paths($path)
2924 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2926 set selected_paths($path) 1
2927 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2931 proc add_range_to_selection {w x y} {
2933 global last_clicked selected_paths
2935 if {[lindex $last_clicked 0] ne $w} {
2936 toggle_or_diff $w $x $y
2940 set pos [split [$w index @$x,$y] .]
2941 set lno [lindex $pos 0]
2942 set lc [lindex $last_clicked 1]
2951 foreach path [lrange $file_lists($w) \
2952 [expr {$begin - 1}] \
2953 [expr {$end - 1}]] {
2954 set selected_paths($path) 1
2956 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2959 ######################################################################
2963 set cursor_ptr arrow
2964 font create font_diff -family Courier -size 10
2968 eval font configure font_ui [font actual [.dummy cget -font]]
2972 font create font_uibold
2973 font create font_diffbold
2978 } elseif {[is_MacOSX]} {
2986 proc apply_config {} {
2987 global repo_config font_descs
2989 foreach option $font_descs {
2990 set name [lindex $option 0]
2991 set font [lindex $option 1]
2993 foreach {cn cv} $repo_config(gui.$name) {
2994 font configure $font $cn $cv
2997 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
2999 foreach {cn cv} [font configure $font] {
3000 font configure ${font}bold $cn $cv
3002 font configure ${font}bold -weight bold
3006 set default_config(gui.trustmtime) false
3007 set default_config(gui.pullsummary) true
3008 set default_config(gui.partialinclude) false
3009 set default_config(gui.diffcontext) 5
3010 set default_config(gui.fontui) [font configure font_ui]
3011 set default_config(gui.fontdiff) [font configure font_diff]
3013 {fontui font_ui {Main Font}}
3014 {fontdiff font_diff {Diff/Console Font}}
3019 ######################################################################
3025 menu .mbar -tearoff 0
3026 .mbar add cascade -label Repository -menu .mbar.repository
3027 .mbar add cascade -label Edit -menu .mbar.edit
3028 if {!$single_commit} {
3029 .mbar add cascade -label Branch -menu .mbar.branch
3031 .mbar add cascade -label Commit -menu .mbar.commit
3032 if {!$single_commit} {
3033 .mbar add cascade -label Fetch -menu .mbar.fetch
3034 .mbar add cascade -label Pull -menu .mbar.pull
3035 .mbar add cascade -label Push -menu .mbar.push
3037 . configure -menu .mbar
3039 # -- Repository Menu
3041 menu .mbar.repository
3042 .mbar.repository add command \
3043 -label {Visualize Current Branch} \
3044 -command {do_gitk {}} \
3047 .mbar.repository add command \
3048 -label {Visualize All Branches} \
3049 -command {do_gitk {--all}} \
3052 .mbar.repository add separator
3054 if {!$single_commit} {
3055 .mbar.repository add command -label {Compress Database} \
3059 .mbar.repository add command -label {Verify Database} \
3060 -command do_fsck_objects \
3063 .mbar.repository add separator
3066 .mbar.repository add command \
3067 -label {Create Desktop Icon} \
3068 -command do_windows_shortcut \
3070 } elseif {[is_MacOSX]} {
3071 .mbar.repository add command \
3072 -label {Create Desktop Icon} \
3073 -command do_macosx_app \
3078 .mbar.repository add command -label Quit \
3080 -accelerator $M1T-Q \
3086 .mbar.edit add command -label Undo \
3087 -command {catch {[focus] edit undo}} \
3088 -accelerator $M1T-Z \
3090 .mbar.edit add command -label Redo \
3091 -command {catch {[focus] edit redo}} \
3092 -accelerator $M1T-Y \
3094 .mbar.edit add separator
3095 .mbar.edit add command -label Cut \
3096 -command {catch {tk_textCut [focus]}} \
3097 -accelerator $M1T-X \
3099 .mbar.edit add command -label Copy \
3100 -command {catch {tk_textCopy [focus]}} \
3101 -accelerator $M1T-C \
3103 .mbar.edit add command -label Paste \
3104 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3105 -accelerator $M1T-V \
3107 .mbar.edit add command -label Delete \
3108 -command {catch {[focus] delete sel.first sel.last}} \
3111 .mbar.edit add separator
3112 .mbar.edit add command -label {Select All} \
3113 -command {catch {[focus] tag add sel 0.0 end}} \
3114 -accelerator $M1T-A \
3119 if {!$single_commit} {
3122 .mbar.branch add command -label {Create...} \
3123 -command do_create_branch \
3125 lappend disable_on_lock [list .mbar.branch entryconf \
3126 [.mbar.branch index last] -state]
3128 .mbar.branch add command -label {Delete...} \
3129 -command do_delete_branch \
3131 lappend disable_on_lock [list .mbar.branch entryconf \
3132 [.mbar.branch index last] -state]
3139 .mbar.commit add radiobutton \
3140 -label {New Commit} \
3141 -command do_select_commit_type \
3142 -variable selected_commit_type \
3145 lappend disable_on_lock \
3146 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3148 .mbar.commit add radiobutton \
3149 -label {Amend Last Commit} \
3150 -command do_select_commit_type \
3151 -variable selected_commit_type \
3154 lappend disable_on_lock \
3155 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3157 .mbar.commit add separator
3159 .mbar.commit add command -label Rescan \
3160 -command do_rescan \
3163 lappend disable_on_lock \
3164 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3166 .mbar.commit add command -label {Add To Commit} \
3167 -command do_include_selection \
3169 lappend disable_on_lock \
3170 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3172 .mbar.commit add command -label {Add All To Commit} \
3173 -command do_include_all \
3174 -accelerator $M1T-I \
3176 lappend disable_on_lock \
3177 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3179 .mbar.commit add command -label {Remove From Commit} \
3180 -command do_remove_selection \
3182 lappend disable_on_lock \
3183 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3185 .mbar.commit add command -label {Revert Changes} \
3186 -command do_revert_selection \
3188 lappend disable_on_lock \
3189 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3191 .mbar.commit add separator
3193 .mbar.commit add command -label {Sign Off} \
3194 -command do_signoff \
3195 -accelerator $M1T-S \
3198 .mbar.commit add command -label Commit \
3199 -command do_commit \
3200 -accelerator $M1T-Return \
3202 lappend disable_on_lock \
3203 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3205 # -- Transport menus
3207 if {!$single_commit} {
3214 # -- Apple Menu (Mac OS X only)
3216 .mbar add cascade -label Apple -menu .mbar.apple
3219 .mbar.apple add command -label "About
$appname" \
3222 .mbar.apple add command -label "$appname Options...
" \
3223 -command do_options \
3228 .mbar.edit add separator
3229 .mbar.edit add command -label {Options...} \
3230 -command do_options \
3235 if {[file exists /usr/local/miga/lib/gui-miga]
3236 && [file exists .pvcsrc]} {
3238 global gitdir ui_status_value
3239 if {![lock_index update]} return
3240 set cmd [list sh --login -c "/usr
/local
/miga
/lib
/gui-miga
\"[pwd]\""]
3241 set miga_fd [open "|
$cmd" r]
3242 fconfigure $miga_fd -blocking 0
3243 fileevent $miga_fd readable [list miga_done $miga_fd]
3244 set ui_status_value {Running miga...}
3246 proc miga_done {fd} {
3251 rescan [list set ui_status_value {Ready.}]
3254 .mbar add cascade -label Tools -menu .mbar.tools
3256 .mbar.tools add command -label "Migrate
" \
3259 lappend disable_on_lock \
3260 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3265 .mbar add cascade -label Help -menu .mbar.help
3268 .mbar.help add command -label "About
$appname" \
3280 -text {Current Branch:} \
3285 -textvariable current_branch \
3289 pack .branch.l1 -side left
3290 pack .branch.cb -side left -fill x
3291 pack .branch -side top -fill x
3293 # -- Main Window Layout
3295 panedwindow .vpane -orient vertical
3296 panedwindow .vpane.files -orient horizontal
3297 .vpane add .vpane.files -sticky nsew -height 100 -width 400
3298 pack .vpane -anchor n -side top -fill both -expand 1
3300 # -- Index File List
3302 frame .vpane.files.index -height 100 -width 400
3303 label .vpane.files.index.title -text {Modified Files} \
3306 text $ui_index -background white -borderwidth 0 \
3307 -width 40 -height 10 \
3309 -cursor $cursor_ptr \
3310 -yscrollcommand {.vpane.files.index.sb set} \
3312 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3313 pack .vpane.files.index.title -side top -fill x
3314 pack .vpane.files.index.sb -side right -fill y
3315 pack $ui_index -side left -fill both -expand 1
3316 .vpane.files add .vpane.files.index -sticky nsew
3318 # -- Other (Add) File List
3320 frame .vpane.files.other -height 100 -width 100
3321 label .vpane.files.other.title -text {Untracked Files} \
3324 text $ui_other -background white -borderwidth 0 \
3325 -width 40 -height 10 \
3327 -cursor $cursor_ptr \
3328 -yscrollcommand {.vpane.files.other.sb set} \
3330 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
3331 pack .vpane.files.other.title -side top -fill x
3332 pack .vpane.files.other.sb -side right -fill y
3333 pack $ui_other -side left -fill both -expand 1
3334 .vpane.files add .vpane.files.other -sticky nsew
3336 foreach i [list $ui_index $ui_other] {
3337 $i tag conf in_diff -font font_uibold
3338 $i tag conf in_sel \
3339 -background [$i cget -foreground] \
3340 -foreground [$i cget -background]
3344 # -- Diff and Commit Area
3346 frame .vpane.lower -height 300 -width 400
3347 frame .vpane.lower.commarea
3348 frame .vpane.lower.diff -relief sunken -borderwidth 1
3349 pack .vpane.lower.commarea -side top -fill x
3350 pack .vpane.lower.diff -side bottom -fill both -expand 1
3351 .vpane add .vpane.lower -stick nsew
3353 # -- Commit Area Buttons
3355 frame .vpane.lower.commarea.buttons
3356 label .vpane.lower.commarea.buttons.l -text {} \
3360 pack .vpane.lower.commarea.buttons.l -side top -fill x
3361 pack .vpane.lower.commarea.buttons -side left -fill y
3363 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3364 -command do_rescan \
3366 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3367 lappend disable_on_lock \
3368 {.vpane.lower.commarea.buttons.rescan conf -state}
3370 button .vpane.lower.commarea.buttons.incall -text {Add All} \
3371 -command do_include_all \
3373 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3374 lappend disable_on_lock \
3375 {.vpane.lower.commarea.buttons.incall conf -state}
3377 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3378 -command do_signoff \
3380 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3382 button .vpane.lower.commarea.buttons.commit -text {Commit} \
3383 -command do_commit \
3385 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3386 lappend disable_on_lock \
3387 {.vpane.lower.commarea.buttons.commit conf -state}
3389 # -- Commit Message Buffer
3391 frame .vpane.lower.commarea.buffer
3392 frame .vpane.lower.commarea.buffer.header
3393 set ui_comm .vpane.lower.commarea.buffer.t
3394 set ui_coml .vpane.lower.commarea.buffer.header.l
3395 radiobutton .vpane.lower.commarea.buffer.header.new \
3396 -text {New Commit} \
3397 -command do_select_commit_type \
3398 -variable selected_commit_type \
3401 lappend disable_on_lock \
3402 [list .vpane.lower.commarea.buffer.header.new conf -state]
3403 radiobutton .vpane.lower.commarea.buffer.header.amend \
3404 -text {Amend Last Commit} \
3405 -command do_select_commit_type \
3406 -variable selected_commit_type \
3409 lappend disable_on_lock \
3410 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3415 proc trace_commit_type {varname args} {
3416 global ui_coml commit_type
3417 switch -glob -- $commit_type {
3418 initial {set txt {Initial Commit Message:}}
3419 amend {set txt {Amended Commit Message:}}
3420 amend-initial {set txt {Amended Initial Commit Message:}}
3421 amend-merge {set txt {Amended Merge Commit Message:}}
3422 merge {set txt {Merge Commit Message:}}
3423 * {set txt {Commit Message:}}
3425 $ui_coml conf -text $txt
3427 trace add variable commit_type write trace_commit_type
3428 pack $ui_coml -side left -fill x
3429 pack .vpane.lower.commarea.buffer.header.amend -side right
3430 pack .vpane.lower.commarea.buffer.header.new -side right
3432 text $ui_comm -background white -borderwidth 1 \
3435 -autoseparators true \
3437 -width 75 -height 9 -wrap none \
3439 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3440 scrollbar .vpane.lower.commarea.buffer.sby \
3441 -command [list $ui_comm yview]
3442 pack .vpane.lower.commarea.buffer.header -side top -fill x
3443 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3444 pack $ui_comm -side left -fill y
3445 pack .vpane.lower.commarea.buffer -side left -fill y
3447 # -- Commit Message Buffer Context Menu
3449 set ctxm .vpane.lower.commarea.buffer.ctxm
3450 menu $ctxm -tearoff 0
3454 -command {tk_textCut $ui_comm}
3458 -command {tk_textCopy $ui_comm}
3462 -command {tk_textPaste $ui_comm}
3466 -command {$ui_comm delete sel.first sel.last}
3469 -label {Select All} \
3471 -command {$ui_comm tag add sel 0.0 end}
3476 $ui_comm tag add sel 0.0 end
3477 tk_textCopy $ui_comm
3478 $ui_comm tag remove sel 0.0 end
3485 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
3490 set diff_actions [list]
3491 proc trace_current_diff {varname args} {
3492 global current_diff diff_actions file_states
3493 if {$current_diff eq {}} {
3500 set s [mapdesc [lindex $file_states($p) 0] $p]
3502 set p [escape_path $p]
3506 .vpane.lower.diff.header.status configure -text $s
3507 .vpane.lower.diff.header.file configure -text $f
3508 .vpane.lower.diff.header.path configure -text $p
3509 foreach w $diff_actions {
3513 trace add variable current_diff write trace_current_diff
3515 frame .vpane.lower.diff.header -background orange
3516 label .vpane.lower.diff.header.status \
3517 -background orange \
3518 -width $max_status_desc \
3522 label .vpane.lower.diff.header.file \
3523 -background orange \
3527 label .vpane.lower.diff.header.path \
3528 -background orange \
3532 pack .vpane.lower.diff.header.status -side left
3533 pack .vpane.lower.diff.header.file -side left
3534 pack .vpane.lower.diff.header.path -fill x
3535 set ctxm .vpane.lower.diff.header.ctxm
3536 menu $ctxm -tearoff 0
3547 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3548 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
3552 frame .vpane.lower.diff.body
3553 set ui_diff .vpane.lower.diff.body.t
3554 text $ui_diff -background white -borderwidth 0 \
3555 -width 80 -height 15 -wrap none \
3557 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3558 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3560 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3561 -command [list $ui_diff xview]
3562 scrollbar .vpane.lower.diff.body.sby -orient vertical \
3563 -command [list $ui_diff yview]
3564 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3565 pack .vpane.lower.diff.body.sby -side right -fill y
3566 pack $ui_diff -side left -fill both -expand 1
3567 pack .vpane.lower.diff.header -side top -fill x
3568 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3570 $ui_diff tag conf d_@ -font font_diffbold
3571 $ui_diff tag conf d_+ -foreground blue
3572 $ui_diff tag conf d_- -foreground red
3573 $ui_diff tag conf d_++ -foreground {#00a000}
3574 $ui_diff tag conf d_-- -foreground {#a000a0}
3575 $ui_diff tag conf d_+- \
3577 -background {light goldenrod yellow}
3578 $ui_diff tag conf d_-+ \
3582 # -- Diff Body Context Menu
3584 set ctxm .vpane.lower.diff.body.ctxm
3585 menu $ctxm -tearoff 0
3589 -command {tk_textCopy $ui_diff}
3590 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3592 -label {Select All} \
3594 -command {$ui_diff tag add sel 0.0 end}
3595 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3600 $ui_diff tag add sel 0.0 end
3601 tk_textCopy $ui_diff
3602 $ui_diff tag remove sel 0.0 end
3604 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3607 -label {Decrease Font Size} \
3609 -command {incr_font_size font_diff -1}
3610 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3612 -label {Increase Font Size} \
3614 -command {incr_font_size font_diff 1}
3615 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3618 -label {Show Less Context} \
3620 -command {if {$repo_config(gui.diffcontext) >= 2} {
3621 incr repo_config(gui.diffcontext) -1
3624 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3626 -label {Show More Context} \
3629 incr repo_config(gui.diffcontext)
3632 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3634 $ctxm add command -label {Options...} \
3637 bind_button3 $ui_diff "tk_popup
$ctxm %X
%Y
"
3641 set ui_status_value {Initializing...}
3642 label .status -textvariable ui_status_value \
3648 pack .status -anchor w -side bottom -fill x
3653 set gm $repo_config(gui.geometry)
3654 wm geometry . [lindex $gm 0]
3655 .vpane sash place 0 \
3656 [lindex [.vpane sash coord 0] 0] \
3658 .vpane.files sash place 0 \
3660 [lindex [.vpane.files sash coord 0] 1]
3666 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3667 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3668 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3669 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3670 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3671 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3672 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3673 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3674 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3675 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3676 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3678 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3679 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3680 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3681 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3682 bind $ui_diff <$M1B-Key-v> {break}
3683 bind $ui_diff <$M1B-Key-V> {break}
3684 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3685 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3686 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3687 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3688 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3689 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3691 bind . <Destroy> do_quit
3692 bind all <Key-F5> do_rescan
3693 bind all <$M1B-Key-r> do_rescan
3694 bind all <$M1B-Key-R> do_rescan
3695 bind . <$M1B-Key-s> do_signoff
3696 bind . <$M1B-Key-S> do_signoff
3697 bind . <$M1B-Key-i> do_include_all
3698 bind . <$M1B-Key-I> do_include_all
3699 bind . <$M1B-Key-Return> do_commit
3700 bind all <$M1B-Key-q> do_quit
3701 bind all <$M1B-Key-Q> do_quit
3702 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3703 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3704 foreach i [list $ui_index $ui_other] {
3705 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
3706 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
3707 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
3711 set file_lists($ui_index) [list]
3712 set file_lists($ui_other) [list]
3716 set MERGE_HEAD [list]
3719 set current_branch {}
3721 set selected_commit_type new
3723 wm title . "$appname ([file normalize
[file dirname $gitdir]])"
3724 focus -force $ui_comm
3726 # -- Warn the user about environmental problems. Cygwin's Tcl
3727 # does *not* pass its env array onto any processes it spawns.
3728 # This means that git processes get none of our environment.
3733 set msg "Possible environment issues exist.
3735 The following environment variables are probably
3736 going to be ignored by any Git subprocess run
3740 foreach name [array names env] {
3741 switch -regexp -- $name {
3742 {^GIT_INDEX_FILE$} -
3743 {^GIT_OBJECT_DIRECTORY$} -
3744 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3746 {^GIT_EXTERNAL_DIFF$} -
3750 {^GIT_CONFIG_LOCAL$} -
3751 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3752 append msg " - $name\n"
3755 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3756 append msg " - $name\n"
3758 set suggest_user $name
3762 if {$ignored_env > 0} {
3764 This is due to a known issue with the
3765 Tcl binary distributed by Cygwin.
"
3767 if {$suggest_user ne {}} {
3770 A good replacement
for $suggest_user
3771 is placing values
for the user.name and
3772 user.email settings into your personal
3778 unset ignored_env msg suggest_user name
3781 # -- Only initialize complex UI if we are going to stay running.
3783 if {!$single_commit} {
3787 populate_branch_menu .mbar.branch
3788 populate_fetch_menu .mbar.fetch
3789 populate_pull_menu .mbar.pull
3790 populate_push_menu .mbar.push
3793 lock_index begin-read