Code

git-gui: Worked around environment variable problems on Windows.
[git.git] / git-gui
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
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 ######################################################################
11 ##
12 ## task management
14 set single_commit 0
15 set status_active 0
16 set diff_active 0
17 set checkin_active 0
18 set commit_active 0
19 set update_index_fd {}
21 set disable_on_lock [list]
22 set index_lock_type none
24 set HEAD {}
25 set PARENT {}
26 set commit_type {}
28 proc lock_index {type} {
29         global index_lock_type disable_on_lock
31         if {$index_lock_type == {none}} {
32                 set index_lock_type $type
33                 foreach w $disable_on_lock {
34                         uplevel #0 $w disabled
35                 }
36                 return 1
37         } elseif {$index_lock_type == {begin-update} && $type == {update}} {
38                 set index_lock_type $type
39                 return 1
40         }
41         return 0
42 }
44 proc unlock_index {} {
45         global index_lock_type disable_on_lock
47         set index_lock_type none
48         foreach w $disable_on_lock {
49                 uplevel #0 $w normal
50         }
51 }
53 ######################################################################
54 ##
55 ## status
57 proc repository_state {hdvar ctvar} {
58         global gitdir
59         upvar $hdvar hd $ctvar ct
61         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
62                 set ct initial
63         } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
64                 set ct merge
65         } else {
66                 set ct normal
67         }
68 }
70 proc update_status {{final Ready.}} {
71         global HEAD PARENT commit_type
72         global ui_index ui_other ui_status_value ui_comm
73         global status_active file_states
75         if {$status_active || ![lock_index read]} return
77         repository_state new_HEAD new_type
78         if {$commit_type == {amend} 
79                 && $new_type == {normal}
80                 && $new_HEAD == $HEAD} {
81         } else {
82                 set HEAD $new_HEAD
83                 set PARENT $new_HEAD
84                 set commit_type $new_type
85         }
87         array unset file_states
88         foreach w [list $ui_index $ui_other] {
89                 $w conf -state normal
90                 $w delete 0.0 end
91                 $w conf -state disabled
92         }
94         if {![$ui_comm edit modified]
95                 || [string trim [$ui_comm get 0.0 end]] == {}} {
96                 if {[load_message GITGUI_MSG]} {
97                 } elseif {[load_message MERGE_MSG]} {
98                 } elseif {[load_message SQUASH_MSG]} {
99                 }
100                 $ui_comm edit modified false
101         }
103         set status_active 1
104         set ui_status_value {Refreshing file status...}
105         set fd_rf [open "| git update-index -q --unmerged --refresh" r]
106         fconfigure $fd_rf -blocking 0 -translation binary
107         fileevent $fd_rf readable [list read_refresh $fd_rf $final]
110 proc read_refresh {fd final} {
111         global gitdir PARENT commit_type
112         global ui_index ui_other ui_status_value ui_comm
113         global status_active file_states
115         read $fd
116         if {![eof $fd]} return
117         close $fd
119         set ls_others [list | git ls-files --others -z \
120                 --exclude-per-directory=.gitignore]
121         set info_exclude [file join $gitdir info exclude]
122         if {[file readable $info_exclude]} {
123                 lappend ls_others "--exclude-from=$info_exclude"
124         }
126         set status_active 3
127         set ui_status_value {Scanning for modified files ...}
128         set fd_di [open "| git diff-index --cached -z $PARENT" r]
129         set fd_df [open "| git diff-files -z" r]
130         set fd_lo [open $ls_others r]
132         fconfigure $fd_di -blocking 0 -translation binary
133         fconfigure $fd_df -blocking 0 -translation binary
134         fconfigure $fd_lo -blocking 0 -translation binary
135         fileevent $fd_di readable [list read_diff_index $fd_di $final]
136         fileevent $fd_df readable [list read_diff_files $fd_df $final]
137         fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
140 proc load_message {file} {
141         global gitdir ui_comm
143         set f [file join $gitdir $file]
144         if {[file isfile $f]} {
145                 if {[catch {set fd [open $f r]}]} {
146                         return 0
147                 }
148                 set content [string trim [read $fd]]
149                 close $fd
150                 $ui_comm delete 0.0 end
151                 $ui_comm insert end $content
152                 return 1
153         }
154         return 0
157 proc read_diff_index {fd final} {
158         global buf_rdi
160         append buf_rdi [read $fd]
161         set pck [split $buf_rdi "\0"]
162         set buf_rdi [lindex $pck end]
163         foreach {m p} [lrange $pck 0 end-1] {
164                 if {$m != {} && $p != {}} {
165                         display_file $p [string index $m end]_
166                 }
167         }
168         status_eof $fd buf_rdi $final
171 proc read_diff_files {fd final} {
172         global buf_rdf
174         append buf_rdf [read $fd]
175         set pck [split $buf_rdf "\0"]
176         set buf_rdf [lindex $pck end]
177         foreach {m p} [lrange $pck 0 end-1] {
178                 if {$m != {} && $p != {}} {
179                         display_file $p _[string index $m end]
180                 }
181         }
182         status_eof $fd buf_rdf $final
185 proc read_ls_others {fd final} {
186         global buf_rlo
188         append buf_rlo [read $fd]
189         set pck [split $buf_rlo "\0"]
190         set buf_rlo [lindex $pck end]
191         foreach p [lrange $pck 0 end-1] {
192                 display_file $p _O
193         }
194         status_eof $fd buf_rlo $final
197 proc status_eof {fd buf final} {
198         global status_active $buf
199         global ui_fname_value ui_status_value file_states
201         if {[eof $fd]} {
202                 set $buf {}
203                 close $fd
204                 if {[incr status_active -1] == 0} {
205                         unlock_index
207                         set ui_status_value $final
208                         if {$ui_fname_value != {} && [array names file_states \
209                                 -exact $ui_fname_value] != {}}  {
210                                 show_diff $ui_fname_value
211                         } else {
212                                 clear_diff
213                         }
214                 }
215         }
218 ######################################################################
219 ##
220 ## diff
222 proc clear_diff {} {
223         global ui_diff ui_fname_value ui_fstatus_value
225         $ui_diff conf -state normal
226         $ui_diff delete 0.0 end
227         $ui_diff conf -state disabled
228         set ui_fname_value {}
229         set ui_fstatus_value {}
232 proc show_diff {path} {
233         global file_states PARENT diff_3way diff_active
234         global ui_diff ui_fname_value ui_fstatus_value ui_status_value
236         if {$diff_active || ![lock_index read]} return
238         clear_diff
239         set s $file_states($path)
240         set m [lindex $s 0]
241         set diff_3way 0
242         set diff_active 1
243         set ui_fname_value $path
244         set ui_fstatus_value [mapdesc $m $path]
245         set ui_status_value "Loading diff of $path..."
247         set cmd [list | git diff-index -p $PARENT -- $path]
248         switch $m {
249         AM {
250         }
251         MM {
252                 set cmd [list | git diff-index -p -c $PARENT $path]
253         }
254         _O {
255                 if {[catch {
256                                 set fd [open $path r]
257                                 set content [read $fd]
258                                 close $fd
259                         } err ]} {
260                         set diff_active 0
261                         unlock_index
262                         set ui_status_value "Unable to display $path"
263                         error_popup "Error loading file:\n$err"
264                         return
265                 }
266                 $ui_diff conf -state normal
267                 $ui_diff insert end $content
268                 $ui_diff conf -state disabled
269                 set diff_active 0
270                 unlock_index
271                 set ui_status_value {Ready.}
272                 return
273         }
274         }
276         if {[catch {set fd [open $cmd r]} err]} {
277                 set diff_active 0
278                 unlock_index
279                 set ui_status_value "Unable to display $path"
280                 error_popup "Error loading diff:\n$err"
281                 return
282         }
284         fconfigure $fd -blocking 0 -translation auto
285         fileevent $fd readable [list read_diff $fd]
288 proc read_diff {fd} {
289         global ui_diff ui_status_value diff_3way diff_active
291         while {[gets $fd line] >= 0} {
292                 if {[string match {diff --git *} $line]} continue
293                 if {[string match {diff --combined *} $line]} continue
294                 if {[string match {--- *} $line]} continue
295                 if {[string match {+++ *} $line]} continue
296                 if {[string match index* $line]} {
297                         if {[string first , $line] >= 0} {
298                                 set diff_3way 1
299                         }
300                 }
302                 $ui_diff conf -state normal
303                 if {!$diff_3way} {
304                         set x [string index $line 0]
305                         switch -- $x {
306                         "@" {set tags da}
307                         "+" {set tags dp}
308                         "-" {set tags dm}
309                         default {set tags {}}
310                         }
311                 } else {
312                         set x [string range $line 0 1]
313                         switch -- $x {
314                         default {set tags {}}
315                         "@@" {set tags da}
316                         "++" {set tags dp; set x " +"}
317                         " +" {set tags {di bold}; set x "++"}
318                         "+ " {set tags dni; set x "-+"}
319                         "--" {set tags dm; set x " -"}
320                         " -" {set tags {dm bold}; set x "--"}
321                         "- " {set tags di; set x "+-"}
322                         default {set tags {}}
323                         }
324                         set line [string replace $line 0 1 $x]
325                 }
326                 $ui_diff insert end $line $tags
327                 $ui_diff insert end "\n"
328                 $ui_diff conf -state disabled
329         }
331         if {[eof $fd]} {
332                 close $fd
333                 set diff_active 0
334                 unlock_index
335                 set ui_status_value {Ready.}
336         }
339 ######################################################################
340 ##
341 ## commit
343 proc load_last_commit {} {
344         global HEAD PARENT commit_type ui_comm
346         if {$commit_type == {amend}} return
347         if {$commit_type != {normal}} {
348                 error_popup "Can't amend a $commit_type commit."
349                 return
350         }
352         set msg {}
353         set parent {}
354         set parent_count 0
355         if {[catch {
356                         set fd [open "| git cat-file commit $HEAD" r]
357                         while {[gets $fd line] > 0} {
358                                 if {[string match {parent *} $line]} {
359                                         set parent [string range $line 7 end]
360                                         incr parent_count
361                                 }
362                         }
363                         set msg [string trim [read $fd]]
364                         close $fd
365                 } err]} {
366                 error_popup "Error loading commit data for amend:\n$err"
367                 return
368         }
370         if {$parent_count == 0} {
371                 set commit_type amend
372                 set HEAD {}
373                 set PARENT {}
374                 update_status
375         } elseif {$parent_count == 1} {
376                 set commit_type amend
377                 set PARENT $parent
378                 $ui_comm delete 0.0 end
379                 $ui_comm insert end $msg
380                 $ui_comm edit modified false
381                 update_status
382         } else {
383                 error_popup {You can't amend a merge commit.}
384                 return
385         }
388 proc commit_tree {} {
389         global tcl_platform HEAD gitdir commit_type file_states
390         global commit_active ui_status_value
391         global ui_comm
393         if {$commit_active || ![lock_index update]} return
395         # -- Our in memory state should match the repository.
396         #
397         repository_state curHEAD cur_type
398         if {$commit_type == {amend} 
399                 && $cur_type == {normal}
400                 && $curHEAD == $HEAD} {
401         } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
402                 error_popup {Last scanned state does not match repository state.
404 Its highly likely that another Git program modified the
405 repository since our last scan.  A rescan is required
406 before committing.
408                 unlock_index
409                 update_status
410                 return
411         }
413         # -- At least one file should differ in the index.
414         #
415         set files_ready 0
416         foreach path [array names file_states] {
417                 set s $file_states($path)
418                 switch -glob -- [lindex $s 0] {
419                 _* {continue}
420                 A* -
421                 D* -
422                 M* {set files_ready 1; break}
423                 U* {
424                         error_popup "Unmerged files cannot be committed.
426 File $path has merge conflicts.
427 You must resolve them and check the file in before committing.
429                         unlock_index
430                         return
431                 }
432                 default {
433                         error_popup "Unknown file state [lindex $s 0] detected.
435 File $path cannot be committed by this program.
437                 }
438                 }
439         }
440         if {!$files_ready} {
441                 error_popup {No checked-in files to commit.
443 You must check-in at least 1 file before you can commit.
445                 unlock_index
446                 return
447         }
449         # -- A message is required.
450         #
451         set msg [string trim [$ui_comm get 1.0 end]]
452         if {$msg == {}} {
453                 error_popup {Please supply a commit message.
455 A good commit message has the following format:
457 - First line: Describe in one sentance what you did.
458 - Second line: Blank
459 - Remaining lines: Describe why this change is good.
461                 unlock_index
462                 return
463         }
465         # -- Ask the pre-commit hook for the go-ahead.
466         #
467         set pchook [file join $gitdir hooks pre-commit]
468         if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
469                 set pchook [list sh -c \
470                         "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
471         } elseif {[file executable $pchook]} {
472                 set pchook [list $pchook]
473         } else {
474                 set pchook {}
475         }
476         if {$pchook != {} && [catch {eval exec $pchook} err]} {
477                 hook_failed_popup pre-commit $err
478                 unlock_index
479                 return
480         }
482         # -- Write the tree in the background.
483         #
484         set commit_active 1
485         set ui_status_value {Committing changes...}
487         set fd_wt [open "| git write-tree" r]
488         fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
491 proc commit_stage2 {fd_wt curHEAD msg} {
492         global single_commit gitdir PARENT commit_type
493         global commit_active ui_status_value ui_comm
495         gets $fd_wt tree_id
496         close $fd_wt
498         if {$tree_id == {}} {
499                 error_popup "write-tree failed"
500                 set commit_active 0
501                 set ui_status_value {Commit failed.}
502                 unlock_index
503                 return
504         }
506         # -- Create the commit.
507         #
508         set cmd [list git commit-tree $tree_id]
509         if {$PARENT != {}} {
510                 lappend cmd -p $PARENT
511         }
512         if {$commit_type == {merge}} {
513                 if {[catch {
514                                 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
515                                 while {[gets $fd_mh merge_head] >= 0} {
516                                         lappend cmd -p $merge_head
517                                 }
518                                 close $fd_mh
519                         } err]} {
520                         error_popup "Loading MERGE_HEADs failed:\n$err"
521                         set commit_active 0
522                         set ui_status_value {Commit failed.}
523                         unlock_index
524                         return
525                 }
526         }
527         if {$PARENT == {}} {
528                 # git commit-tree writes to stderr during initial commit.
529                 lappend cmd 2>/dev/null
530         }
531         lappend cmd << $msg
532         if {[catch {set cmt_id [eval exec $cmd]} err]} {
533                 error_popup "commit-tree failed:\n$err"
534                 set commit_active 0
535                 set ui_status_value {Commit failed.}
536                 unlock_index
537                 return
538         }
540         # -- Update the HEAD ref.
541         #
542         set reflogm commit
543         if {$commit_type != {normal}} {
544                 append reflogm " ($commit_type)"
545         }
546         set i [string first "\n" $msg]
547         if {$i >= 0} {
548                 append reflogm {: } [string range $msg 0 [expr $i - 1]]
549         } else {
550                 append reflogm {: } $msg
551         }
552         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
553         if {[catch {eval exec $cmd} err]} {
554                 error_popup "update-ref failed:\n$err"
555                 set commit_active 0
556                 set ui_status_value {Commit failed.}
557                 unlock_index
558                 return
559         }
561         # -- Cleanup after ourselves.
562         #
563         catch {file delete [file join $gitdir MERGE_HEAD]}
564         catch {file delete [file join $gitdir MERGE_MSG]}
565         catch {file delete [file join $gitdir SQUASH_MSG]}
566         catch {file delete [file join $gitdir GITGUI_MSG]}
568         # -- Let rerere do its thing.
569         #
570         if {[file isdirectory [file join $gitdir rr-cache]]} {
571                 catch {exec git rerere}
572         }
574         $ui_comm delete 0.0 end
575         $ui_comm edit modified false
577         if {$single_commit} do_quit
579         set commit_type {}
580         set commit_active 0
581         set HEAD $cmt_id
582         set PARENT $cmt_id
583         unlock_index
584         update_status "Changes committed as $cmt_id."
587 ######################################################################
588 ##
589 ## fetch pull push
591 proc fetch_from {remote} {
592         set w [new_console "fetch $remote" \
593                 "Fetching new changes from $remote"]
594         set cmd [list git fetch]
595         lappend cmd -v
596         lappend cmd $remote
597         console_exec $w $cmd
600 proc push_to {remote} {
601         set w [new_console "push $remote" \
602                 "Pushing changes to $remote"]
603         set cmd [list git push]
604         lappend -v
605         lappend cmd $remote
606         console_exec $w $cmd
609 ######################################################################
610 ##
611 ## ui helpers
613 proc mapcol {state path} {
614         global all_cols
616         if {[catch {set r $all_cols($state)}]} {
617                 puts "error: no column for state={$state} $path"
618                 return o
619         }
620         return $r
623 proc mapicon {state path} {
624         global all_icons
626         if {[catch {set r $all_icons($state)}]} {
627                 puts "error: no icon for state={$state} $path"
628                 return file_plain
629         }
630         return $r
633 proc mapdesc {state path} {
634         global all_descs
636         if {[catch {set r $all_descs($state)}]} {
637                 puts "error: no desc for state={$state} $path"
638                 return $state
639         }
640         return $r
643 proc bsearch {w path} {
644         set hi [expr [lindex [split [$w index end] .] 0] - 2]
645         if {$hi == 0} {
646                 return -1
647         }
648         set lo 0
649         while {$lo < $hi} {
650                 set mi [expr [expr $lo + $hi] / 2]
651                 set ti [expr $mi + 1]
652                 set cmp [string compare [$w get $ti.1 $ti.end] $path]
653                 if {$cmp < 0} {
654                         set lo $ti
655                 } elseif {$cmp == 0} {
656                         return $mi
657                 } else {
658                         set hi $mi
659                 }
660         }
661         return -[expr $lo + 1]
664 proc merge_state {path state} {
665         global file_states
667         if {[array names file_states -exact $path] == {}}  {
668                 set o __
669                 set s [list $o none none]
670         } else {
671                 set s $file_states($path)
672                 set o [lindex $s 0]
673         }
675         set m [lindex $s 0]
676         if {[string index $state 0] == "_"} {
677                 set state [string index $m 0][string index $state 1]
678         } elseif {[string index $state 0] == "*"} {
679                 set state _[string index $state 1]
680         }
682         if {[string index $state 1] == "_"} {
683                 set state [string index $state 0][string index $m 1]
684         } elseif {[string index $state 1] == "*"} {
685                 set state [string index $state 0]_
686         }
688         set file_states($path) [lreplace $s 0 0 $state]
689         return $o
692 proc display_file {path state} {
693         global ui_index ui_other file_states
695         set old_m [merge_state $path $state]
696         set s $file_states($path)
697         set m [lindex $s 0]
699         if {[mapcol $m $path] == "o"} {
700                 set ii 1
701                 set ai 2
702                 set iw $ui_index
703                 set aw $ui_other
704         } else {
705                 set ii 2
706                 set ai 1
707                 set iw $ui_other
708                 set aw $ui_index
709         }
711         set d [lindex $s $ii]
712         if {$d != "none"} {
713                 set lno [bsearch $iw $path]
714                 if {$lno >= 0} {
715                         incr lno
716                         $iw conf -state normal
717                         $iw delete $lno.0 [expr $lno + 1].0
718                         $iw conf -state disabled
719                         set s [lreplace $s $ii $ii none]
720                 }
721         }
723         set d [lindex $s $ai]
724         if {$d == "none"} {
725                 set lno [expr abs([bsearch $aw $path] + 1) + 1]
726                 $aw conf -state normal
727                 set ico [$aw image create $lno.0 \
728                         -align center -padx 5 -pady 1 \
729                         -image [mapicon $m $path]]
730                 $aw insert $lno.1 "$path\n"
731                 $aw conf -state disabled
732                 set file_states($path) [lreplace $s $ai $ai [list $ico]]
733         } elseif {[mapicon $m $path] != [mapicon $old_m $path]} {
734                 set ico [lindex $d 0]
735                 $aw image conf $ico -image [mapicon $m $path]
736         }
739 proc with_update_index {body} {
740         global update_index_fd
742         if {$update_index_fd == {}} {
743                 if {![lock_index update]} return
744                 set update_index_fd [open \
745                         "| git update-index --add --remove -z --stdin" \
746                         w]
747                 fconfigure $update_index_fd -translation binary
748                 uplevel 1 $body
749                 close $update_index_fd
750                 set update_index_fd {}
751                 unlock_index
752         } else {
753                 uplevel 1 $body
754         }
757 proc update_index {path} {
758         global update_index_fd
760         if {$update_index_fd == {}} {
761                 error {not in with_update_index}
762         } else {
763                 puts -nonewline $update_index_fd "$path\0"
764         }
767 proc toggle_mode {path} {
768         global file_states ui_fname_value
770         set s $file_states($path)
771         set m [lindex $s 0]
773         switch -- $m {
774         AM -
775         _O {set new A*}
776         _M -
777         MM {set new M*}
778         AD -
779         _D {set new D*}
780         default {return}
781         }
783         with_update_index {update_index $path}
784         display_file $path $new
785         if {$ui_fname_value == $path} {
786                 show_diff $path
787         }
790 ######################################################################
791 ##
792 ## config (fetch push pull)
794 proc load_all_remotes {} {
795         global gitdir all_remotes
797         set all_remotes [list]
798         set rm_dir [file join $gitdir remotes]
799         if {[file isdirectory $rm_dir]} {
800                 set all_remotes [concat $all_remotes \
801                         [glob -types f -tails -directory $rm_dir * *]]
802         }
804         set fd_rc [open "| git repo-config --list" r]
805         while {[gets $fd_rc line] >= 0} {
806                 if {[regexp ^remote\.(.*)\.url= $line line name]} {
807                         lappend all_remotes $name
808                 }
809         }
810         close $fd_rc
812         set all_remotes [lsort -unique $all_remotes]
815 proc populate_remote_menu {m pfx op} {
816         global gitdir all_remotes mainfont
818         foreach remote $all_remotes {
819                 $m add command -label "$pfx $remote..." \
820                         -command [list $op $remote] \
821                         -font $mainfont
822         }
825 ######################################################################
826 ##
827 ## icons
829 set filemask {
830 #define mask_width 14
831 #define mask_height 15
832 static unsigned char mask_bits[] = {
833    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
834    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
835    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
838 image create bitmap file_plain -background white -foreground black -data {
839 #define plain_width 14
840 #define plain_height 15
841 static unsigned char plain_bits[] = {
842    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
843    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
844    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
845 } -maskdata $filemask
847 image create bitmap file_mod -background white -foreground blue -data {
848 #define mod_width 14
849 #define mod_height 15
850 static unsigned char mod_bits[] = {
851    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
852    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
853    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
854 } -maskdata $filemask
856 image create bitmap file_fulltick -background white -foreground "#007000" -data {
857 #define file_fulltick_width 14
858 #define file_fulltick_height 15
859 static unsigned char file_fulltick_bits[] = {
860    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
861    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
862    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
863 } -maskdata $filemask
865 image create bitmap file_parttick -background white -foreground "#005050" -data {
866 #define parttick_width 14
867 #define parttick_height 15
868 static unsigned char parttick_bits[] = {
869    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
870    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
871    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
872 } -maskdata $filemask
874 image create bitmap file_question -background white -foreground black -data {
875 #define file_question_width 14
876 #define file_question_height 15
877 static unsigned char file_question_bits[] = {
878    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
879    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
880    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
881 } -maskdata $filemask
883 image create bitmap file_removed -background white -foreground red -data {
884 #define file_removed_width 14
885 #define file_removed_height 15
886 static unsigned char file_removed_bits[] = {
887    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
888    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
889    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
890 } -maskdata $filemask
892 image create bitmap file_merge -background white -foreground blue -data {
893 #define file_merge_width 14
894 #define file_merge_height 15
895 static unsigned char file_merge_bits[] = {
896    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
897    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
898    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
899 } -maskdata $filemask
901 set max_status_desc 0
902 foreach i {
903                 {__ i plain    "Unmodified"}
904                 {_M i mod      "Modified"}
905                 {M_ i fulltick "Checked in"}
906                 {MM i parttick "Partially checked in"}
908                 {_O o plain    "Untracked"}
909                 {A_ o fulltick "Added"}
910                 {AM o parttick "Partially added"}
911                 {AD o question  "Added (but now gone)"}
913                 {_D i question "Missing"}
914                 {D_ i removed  "Removed"}
915                 {DD i removed  "Removed"}
916                 {DO i removed  "Removed (still exists)"}
918                 {UM i merge    "Merge conflicts"}
919                 {U_ i merge    "Merge conflicts"}
920         } {
921         if {$max_status_desc < [string length [lindex $i 3]]} {
922                 set max_status_desc [string length [lindex $i 3]]
923         }
924         set all_cols([lindex $i 0]) [lindex $i 1]
925         set all_icons([lindex $i 0]) file_[lindex $i 2]
926         set all_descs([lindex $i 0]) [lindex $i 3]
928 unset filemask i
930 ######################################################################
931 ##
932 ## util
934 proc error_popup {msg} {
935         set w .error
936         toplevel $w
937         wm transient $w .
938         show_msg $w $w $msg
941 proc show_msg {w top msg} {
942         global gitdir appname
944         message $w.m -text $msg -justify left -aspect 400
945         pack $w.m -side top -fill x -padx 5 -pady 10
946         button $w.ok -text OK \
947                 -width 15 \
948                 -font $mainfont \
949                 -command "destroy $top"
950         pack $w.ok -side bottom
951         bind $top <Visibility> "grab $top; focus $top"
952         bind $top <Key-Return> "destroy $top"
953         wm title $top "error: $appname ([file normalize [file dirname $gitdir]])"
954         tkwait window $top
957 proc hook_failed_popup {hook msg} {
958         global gitdir mainfont difffont appname
960         set w .hookfail
961         toplevel $w
962         wm transient $w .
964         frame $w.m
965         label $w.m.l1 -text "$hook hook failed:" \
966                 -anchor w \
967                 -justify left \
968                 -font [concat $mainfont bold]
969         text $w.m.t \
970                 -background white -borderwidth 1 \
971                 -relief sunken \
972                 -width 80 -height 10 \
973                 -font $difffont \
974                 -yscrollcommand [list $w.m.sby set]
975         label $w.m.l2 \
976                 -text {You must correct the above errors before committing.} \
977                 -anchor w \
978                 -justify left \
979                 -font [concat $mainfont bold]
980         scrollbar $w.m.sby -command [list $w.m.t yview]
981         pack $w.m.l1 -side top -fill x
982         pack $w.m.l2 -side bottom -fill x
983         pack $w.m.sby -side right -fill y
984         pack $w.m.t -side left -fill both -expand 1
985         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
987         $w.m.t insert 1.0 $msg
988         $w.m.t conf -state disabled
990         button $w.ok -text OK \
991                 -width 15 \
992                 -font $mainfont \
993                 -command "destroy $w"
994         pack $w.ok -side bottom
996         bind $w <Visibility> "grab $w; focus $w"
997         bind $w <Key-Return> "destroy $w"
998         wm title $w "error: $appname ([file normalize [file dirname $gitdir]])"
999         tkwait window $w
1002 set next_console_id 0
1004 proc new_console {short_title long_title} {
1005         global next_console_id gitdir appname mainfont difffont
1007         set w .console[incr next_console_id]
1008         toplevel $w
1009         frame $w.m
1010         label $w.m.l1 -text "$long_title:" \
1011                 -anchor w \
1012                 -justify left \
1013                 -font [concat $mainfont bold]
1014         text $w.m.t \
1015                 -background white -borderwidth 1 \
1016                 -relief sunken \
1017                 -width 80 -height 10 \
1018                 -font $difffont \
1019                 -state disabled \
1020                 -yscrollcommand [list $w.m.sby set]
1021         scrollbar $w.m.sby -command [list $w.m.t yview]
1022         pack $w.m.l1 -side top -fill x
1023         pack $w.m.sby -side right -fill y
1024         pack $w.m.t -side left -fill both -expand 1
1025         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1027         button $w.ok -text {OK} \
1028                 -width 15 \
1029                 -font $mainfont \
1030                 -state disabled \
1031                 -command "destroy $w"
1032         pack $w.ok -side bottom
1034         bind $w <Visibility> "focus $w"
1035         bind $w <Destroy> break
1036         wm title $w "$appname ([file dirname [file normalize [file dirname $gitdir]]]): $short_title"
1037         return $w
1040 proc console_exec {w cmd} {
1041         global tcl_platform
1043         # -- Windows tosses the enviroment when we exec our child.
1044         #    But most users need that so we have to relogin. :-(
1045         #
1046         if {$tcl_platform(platform) == {windows}} {
1047                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1048         }
1050         # -- Tcl won't let us redirect both stdout and stderr to
1051         #    the same pipe.  So pass it through cat...
1052         #
1053         set cmd [concat | $cmd |& cat]
1055         set fd_f [open $cmd r]
1056         fconfigure $fd_f -blocking 0 -translation auto
1057         fileevent $fd_f readable [list console_read $w $fd_f]
1060 proc console_read {w fd} {
1061         $w.m.t conf -state normal
1062         while {[gets $fd line] >= 0} {
1063                 $w.m.t insert end $line
1064                 $w.m.t insert end "\n"
1065         }
1066         $w.m.t conf -state disabled
1067         $w.m.t see end
1069         if {[eof $fd]} {
1070                 close $fd
1071                 $w.ok conf -state normal
1072         }
1075 ######################################################################
1076 ##
1077 ## ui commands
1079 set starting_gitk_msg {Please wait... Starting gitk...}
1081 proc do_gitk {} {
1082         global tcl_platform ui_status_value starting_gitk_msg
1084         set ui_status_value $starting_gitk_msg
1085         after 10000 {
1086                 if {$ui_status_value == $starting_gitk_msg} {
1087                         set ui_status_value {Ready.}
1088                 }
1089         }
1091         if {$tcl_platform(platform) == {windows}} {
1092                 exec sh -c gitk &
1093         } else {
1094                 exec gitk &
1095         }
1098 proc do_quit {} {
1099         global gitdir ui_comm
1101         set save [file join $gitdir GITGUI_MSG]
1102         set msg [string trim [$ui_comm get 0.0 end]]
1103         if {[$ui_comm edit modified] && $msg != {}} {
1104                 catch {
1105                         set fd [open $save w]
1106                         puts $fd [string trim [$ui_comm get 0.0 end]]
1107                         close $fd
1108                 }
1109         } elseif {$msg == {} && [file exists $save]} {
1110                 file delete $save
1111         }
1113         destroy .
1116 proc do_rescan {} {
1117         update_status
1120 proc do_checkin_all {} {
1121         global checkin_active ui_status_value
1123         if {$checkin_active || ![lock_index begin-update]} return
1125         set checkin_active 1
1126         set ui_status_value {Checking in all files...}
1127         after 1 {
1128                 with_update_index {
1129                         foreach path [array names file_states] {
1130                                 set s $file_states($path)
1131                                 set m [lindex $s 0]
1132                                 switch -- $m {
1133                                 AM -
1134                                 MM -
1135                                 _M -
1136                                 _D {toggle_mode $path}
1137                                 }
1138                         }
1139                 }
1140                 set checkin_active 0
1141                 set ui_status_value {Ready.}
1142         }
1145 proc do_signoff {} {
1146         global ui_comm
1148         catch {
1149                 set me [exec git var GIT_COMMITTER_IDENT]
1150                 if {[regexp {(.*) [0-9]+ [-+0-9]+$} $me me name]} {
1151                         set str "Signed-off-by: $name"
1152                         if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1153                                 $ui_comm insert end "\n"
1154                                 $ui_comm insert end $str
1155                                 $ui_comm see end
1156                         }
1157                 }
1158         }
1161 proc do_amend_last {} {
1162         load_last_commit
1165 proc do_commit {} {
1166         commit_tree
1169 # shift == 1: left click
1170 #          3: right click  
1171 proc click {w x y shift wx wy} {
1172         global ui_index ui_other
1174         set pos [split [$w index @$x,$y] .]
1175         set lno [lindex $pos 0]
1176         set col [lindex $pos 1]
1177         set path [$w get $lno.1 $lno.end]
1178         if {$path == {}} return
1180         if {$col > 0 && $shift == 1} {
1181                 $ui_index tag remove in_diff 0.0 end
1182                 $ui_other tag remove in_diff 0.0 end
1183                 $w tag add in_diff $lno.0 [expr $lno + 1].0
1184                 show_diff $path
1185         }
1188 proc unclick {w x y} {
1189         set pos [split [$w index @$x,$y] .]
1190         set lno [lindex $pos 0]
1191         set col [lindex $pos 1]
1192         set path [$w get $lno.1 $lno.end]
1193         if {$path == {}} return
1195         if {$col == 0} {
1196                 toggle_mode $path
1197         }
1200 ######################################################################
1201 ##
1202 ## ui init
1204 set mainfont {Helvetica 10}
1205 set difffont {Courier 10}
1206 set maincursor [. cget -cursor]
1208 switch -- $tcl_platform(platform) {
1209 windows {set M1B Control; set M1T Ctrl}
1210 default {set M1B M1; set M1T M1}
1213 # -- Menu Bar
1214 menu .mbar -tearoff 0
1215 .mbar add cascade -label Project -menu .mbar.project
1216 .mbar add cascade -label Commit -menu .mbar.commit
1217 .mbar add cascade -label Fetch -menu .mbar.fetch
1218 .mbar add cascade -label Pull -menu .mbar.pull
1219 .mbar add cascade -label Push -menu .mbar.push
1220 . configure -menu .mbar
1222 # -- Project Menu
1223 menu .mbar.project
1224 .mbar.project add command -label Visualize \
1225         -command do_gitk \
1226         -font $mainfont
1227 .mbar.project add command -label Quit \
1228         -command do_quit \
1229         -accelerator $M1T-Q \
1230         -font $mainfont
1232 # -- Commit Menu
1233 menu .mbar.commit
1234 .mbar.commit add command -label Rescan \
1235         -command do_rescan \
1236         -accelerator F5 \
1237         -font $mainfont
1238 lappend disable_on_lock \
1239         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1240 .mbar.commit add command -label {Amend Last Commit} \
1241         -command do_amend_last \
1242         -font $mainfont
1243 lappend disable_on_lock \
1244         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1245 .mbar.commit add command -label {Check-in All Files} \
1246         -command do_checkin_all \
1247         -accelerator $M1T-U \
1248         -font $mainfont
1249 lappend disable_on_lock \
1250         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1251 .mbar.commit add command -label {Sign Off} \
1252         -command do_signoff \
1253         -accelerator $M1T-S \
1254         -font $mainfont
1255 .mbar.commit add command -label Commit \
1256         -command do_commit \
1257         -accelerator $M1T-Return \
1258         -font $mainfont
1259 lappend disable_on_lock \
1260         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1262 # -- Fetch Menu
1263 menu .mbar.fetch
1265 # -- Pull Menu
1266 menu .mbar.pull
1268 # -- Push Menu
1269 menu .mbar.push
1271 # -- Main Window Layout
1272 panedwindow .vpane -orient vertical
1273 panedwindow .vpane.files -orient horizontal
1274 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1275 pack .vpane -anchor n -side top -fill both -expand 1
1277 # -- Index File List
1278 set ui_index .vpane.files.index.list
1279 frame .vpane.files.index -height 100 -width 400
1280 label .vpane.files.index.title -text {Modified Files} \
1281         -background green \
1282         -font $mainfont
1283 text $ui_index -background white -borderwidth 0 \
1284         -width 40 -height 10 \
1285         -font $mainfont \
1286         -yscrollcommand {.vpane.files.index.sb set} \
1287         -cursor $maincursor \
1288         -state disabled
1289 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1290 pack .vpane.files.index.title -side top -fill x
1291 pack .vpane.files.index.sb -side right -fill y
1292 pack $ui_index -side left -fill both -expand 1
1293 .vpane.files add .vpane.files.index -sticky nsew
1295 # -- Other (Add) File List
1296 set ui_other .vpane.files.other.list
1297 frame .vpane.files.other -height 100 -width 100
1298 label .vpane.files.other.title -text {Untracked Files} \
1299         -background red \
1300         -font $mainfont
1301 text $ui_other -background white -borderwidth 0 \
1302         -width 40 -height 10 \
1303         -font $mainfont \
1304         -yscrollcommand {.vpane.files.other.sb set} \
1305         -cursor $maincursor \
1306         -state disabled
1307 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1308 pack .vpane.files.other.title -side top -fill x
1309 pack .vpane.files.other.sb -side right -fill y
1310 pack $ui_other -side left -fill both -expand 1
1311 .vpane.files add .vpane.files.other -sticky nsew
1313 $ui_index tag conf in_diff -font [concat $mainfont bold]
1314 $ui_other tag conf in_diff -font [concat $mainfont bold]
1316 # -- Diff Header
1317 set ui_fname_value {}
1318 set ui_fstatus_value {}
1319 frame .vpane.diff -height 200 -width 400
1320 frame .vpane.diff.header
1321 label .vpane.diff.header.l1 -text {File:} -font $mainfont
1322 label .vpane.diff.header.l2 -textvariable ui_fname_value \
1323         -anchor w \
1324         -justify left \
1325         -font $mainfont
1326 label .vpane.diff.header.l3 -text {Status:} -font $mainfont
1327 label .vpane.diff.header.l4 -textvariable ui_fstatus_value \
1328         -width $max_status_desc \
1329         -anchor w \
1330         -justify left \
1331         -font $mainfont
1332 pack .vpane.diff.header.l1 -side left
1333 pack .vpane.diff.header.l2 -side left -fill x
1334 pack .vpane.diff.header.l4 -side right
1335 pack .vpane.diff.header.l3 -side right
1337 # -- Diff Body
1338 frame .vpane.diff.body
1339 set ui_diff .vpane.diff.body.t
1340 text $ui_diff -background white -borderwidth 0 \
1341         -width 80 -height 15 -wrap none \
1342         -font $difffont \
1343         -xscrollcommand {.vpane.diff.body.sbx set} \
1344         -yscrollcommand {.vpane.diff.body.sby set} \
1345         -cursor $maincursor \
1346         -state disabled
1347 scrollbar .vpane.diff.body.sbx -orient horizontal \
1348         -command [list $ui_diff xview]
1349 scrollbar .vpane.diff.body.sby -orient vertical \
1350         -command [list $ui_diff yview]
1351 pack .vpane.diff.body.sbx -side bottom -fill x
1352 pack .vpane.diff.body.sby -side right -fill y
1353 pack $ui_diff -side left -fill both -expand 1
1354 pack .vpane.diff.header -side top -fill x
1355 pack .vpane.diff.body -side bottom -fill both -expand 1
1356 .vpane add .vpane.diff -stick nsew
1358 $ui_diff tag conf dm -foreground red
1359 $ui_diff tag conf dp -foreground blue
1360 $ui_diff tag conf da -font [concat $difffont bold]
1361 $ui_diff tag conf di -foreground "#00a000"
1362 $ui_diff tag conf dni -foreground "#a000a0"
1363 $ui_diff tag conf bold -font [concat $difffont bold]
1365 # -- Commit Area
1366 frame .vpane.commarea -height 170
1367 .vpane add .vpane.commarea -stick nsew
1369 # -- Commit Area Buttons
1370 frame .vpane.commarea.buttons
1371 label .vpane.commarea.buttons.l -text {} \
1372         -anchor w \
1373         -justify left \
1374         -font $mainfont
1375 pack .vpane.commarea.buttons.l -side top -fill x
1376 pack .vpane.commarea.buttons -side left -fill y
1378 button .vpane.commarea.buttons.rescan -text {Rescan} \
1379         -command do_rescan \
1380         -font $mainfont
1381 pack .vpane.commarea.buttons.rescan -side top -fill x
1382 lappend disable_on_lock {.vpane.commarea.buttons.rescan conf -state}
1384 button .vpane.commarea.buttons.amend -text {Amend Last} \
1385         -command do_amend_last \
1386         -font $mainfont
1387 pack .vpane.commarea.buttons.amend -side top -fill x
1388 lappend disable_on_lock {.vpane.commarea.buttons.amend conf -state}
1390 button .vpane.commarea.buttons.ciall -text {Check-in All} \
1391         -command do_checkin_all \
1392         -font $mainfont
1393 pack .vpane.commarea.buttons.ciall -side top -fill x
1394 lappend disable_on_lock {.vpane.commarea.buttons.ciall conf -state}
1396 button .vpane.commarea.buttons.signoff -text {Sign Off} \
1397         -command do_signoff \
1398         -font $mainfont
1399 pack .vpane.commarea.buttons.signoff -side top -fill x
1401 button .vpane.commarea.buttons.commit -text {Commit} \
1402         -command do_commit \
1403         -font $mainfont
1404 pack .vpane.commarea.buttons.commit -side top -fill x
1405 lappend disable_on_lock {.vpane.commarea.buttons.commit conf -state}
1407 # -- Commit Message Buffer
1408 frame .vpane.commarea.buffer
1409 set ui_comm .vpane.commarea.buffer.t
1410 set ui_coml .vpane.commarea.buffer.l
1411 label $ui_coml -text {Commit Message:} \
1412         -anchor w \
1413         -justify left \
1414         -font $mainfont
1415 trace add variable commit_type write {uplevel #0 {
1416         switch -glob $commit_type \
1417         initial {$ui_coml conf -text {Initial Commit Message:}} \
1418         amend   {$ui_coml conf -text {Amended Commit Message:}} \
1419         merge   {$ui_coml conf -text {Merge Commit Message:}} \
1420         *       {$ui_coml conf -text {Commit Message:}}
1421 }}
1422 text $ui_comm -background white -borderwidth 1 \
1423         -relief sunken \
1424         -width 75 -height 10 -wrap none \
1425         -font $difffont \
1426         -yscrollcommand {.vpane.commarea.buffer.sby set} \
1427         -cursor $maincursor
1428 scrollbar .vpane.commarea.buffer.sby -command [list $ui_comm yview]
1429 pack $ui_coml -side top -fill x
1430 pack .vpane.commarea.buffer.sby -side right -fill y
1431 pack $ui_comm -side left -fill y
1432 pack .vpane.commarea.buffer -side left -fill y
1434 # -- Status Bar
1435 set ui_status_value {Initializing...}
1436 label .status -textvariable ui_status_value \
1437         -anchor w \
1438         -justify left \
1439         -borderwidth 1 \
1440         -relief sunken \
1441         -font $mainfont
1442 pack .status -anchor w -side bottom -fill x
1444 # -- Key Bindings
1445 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1446 bind . <Destroy> do_quit
1447 bind . <Key-F5> do_rescan
1448 bind . <$M1B-Key-r> do_rescan
1449 bind . <$M1B-Key-R> do_rescan
1450 bind . <$M1B-Key-s> do_signoff
1451 bind . <$M1B-Key-S> do_signoff
1452 bind . <$M1B-Key-u> do_checkin_all
1453 bind . <$M1B-Key-U> do_checkin_all
1454 bind . <$M1B-Key-Return> do_commit
1455 bind . <$M1B-Key-q> do_quit
1456 bind . <$M1B-Key-Q> do_quit
1457 foreach i [list $ui_index $ui_other] {
1458         bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1459         bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1460         bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1462 unset i M1B M1T
1464 ######################################################################
1465 ##
1466 ## main
1468 if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1469         show_msg {} . "Cannot find the git directory: $err"
1470         exit 1
1472 set cdup [exec git rev-parse --show-cdup]
1473 if {$cdup != ""} {
1474         cd $cdup
1476 unset cdup
1478 set appname [lindex [file split $argv0] end]
1479 if {$appname == {git-citool}} {
1480         set single_commit 1
1483 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1484 focus -force $ui_comm
1485 load_all_remotes
1486 populate_remote_menu .mbar.fetch From fetch_from
1487 populate_remote_menu .mbar.push To push_to
1488 update_status