# and distributed under the terms of the GNU General Public Licence,
# either version 2, or (at your option) any later version.
-package require Tk
-
proc gitdir {} {
global env
if {[info exists env(GIT_DIR)]} {
}
}
+proc create_bitmaps {} {
image create bitmap tri-rt -background black -foreground blue -data {
#define tri-rt_width 13
#define tri-rt_height 13
-data $rectdata -maskdata $rectmask
image create bitmap reficon-o -background black -foreground "#ddddff" \
-data $rectdata -maskdata $rectmask
+}
proc init_flist {first} {
global cflist cflist_top difffilestart
}
}
-if {[package vsatisfies [package provide Tk] 8.6]} {
+proc init_font_chooser {} {
# In Tk 8.6 we have a native font chooser dialog. Overwrite the above
# function to make use of it.
+ if {![package vsatisfies [package provide Tk] 8.6]} { return }
proc choosefont {font which} {
tk fontchooser configure -title $which -font $font \
-command [list on_choosefont $font $which]
return $tcl_enc
}
-# First check that Tcl/Tk is recent enough
-if {[catch {package require Tk 8.4} err]} {
- show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
- Gitk requires at least Tcl/Tk 8.4." list
- exit 1
-}
-
-# defaults...
-set wrcomcmd "git diff-tree --stdin -p --pretty"
-
-set gitencoding {}
-catch {
- set gitencoding [exec git config --get i18n.commitencoding]
-}
-catch {
- set gitencoding [exec git config --get i18n.logoutputencoding]
-}
-if {$gitencoding == ""} {
- set gitencoding "utf-8"
-}
-set tclencoding [tcl_encoding $gitencoding]
-if {$tclencoding == {}} {
- puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
-}
+# main is capable of being evaluated by Tcl 8.2 and above.
+# this means no eq/ne in the body.
+proc main {args} {
+ global env argv0
-set gui_encoding [encoding system]
-catch {
- set enc [exec git config --get gui.encoding]
- if {$enc ne {}} {
- set tclenc [tcl_encoding $enc]
- if {$tclenc ne {}} {
- set gui_encoding $tclenc
- } else {
- puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
- }
- }
-}
-
-if {[tk windowingsystem] eq "aqua"} {
- set mainfont {{Lucida Grande} 9}
- set textfont {Monaco 9}
- set uifont {{Lucida Grande} 9 bold}
-} else {
- set mainfont {Helvetica 9}
- set textfont {Courier 9}
- set uifont {Helvetica 9 bold}
-}
-set tabstop 8
-set findmergefiles 0
-set maxgraphpct 50
-set maxwidth 16
-set revlistorder 0
-set fastdate 0
-set uparrowlen 5
-set downarrowlen 5
-set mingaplen 100
-set cmitmode "patch"
-set wrapcomment "none"
-set showneartags 1
-set hideremotes 0
-set maxrefs 20
-set maxlinelen 200
-set showlocalchanges 1
-set limitdiffs 1
-set datetimeformat "%Y-%m-%d %H:%M:%S"
-set autoselect 1
-set perfile_attrs 0
-set want_ttk 1
-
-if {[tk windowingsystem] eq "aqua"} {
- set extdifftool "opendiff"
-} else {
- set extdifftool "meld"
-}
-
-set colors {green red blue magenta darkgrey brown orange}
-if {[tk windowingsystem] eq "win32"} {
- set uicolor SystemButtonFace
- set bgcolor SystemWindow
- set fgcolor SystemButtonText
- set selectbgcolor SystemHighlight
-} else {
- set uicolor grey85
- set bgcolor white
- set fgcolor black
- set selectbgcolor gray85
-}
-set diffcolors {red "#00a000" blue}
-set diffcontext 3
-set ignorespace 0
-set markbgcolor "#e0e0ff"
-
-set circlecolors {white blue gray blue blue}
-
-# button for popping up context menus
-if {[tk windowingsystem] eq "aqua"} {
- set ctxbut <Button-2>
-} else {
- set ctxbut <Button-3>
-}
-
-## For msgcat loading, first locate the installation location.
-if { [info exists ::env(GITK_MSGSDIR)] } {
- ## Msgsdir was manually set in the environment.
- set gitk_msgsdir $::env(GITK_MSGSDIR)
-} else {
- ## Let's guess the prefix from argv0.
- set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
- set gitk_libdir [file join $gitk_prefix share gitk lib]
- set gitk_msgsdir [file join $gitk_libdir msgs]
- unset gitk_prefix
-}
-
-## Internationalization (i18n) through msgcat and gettext. See
-## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
-package require msgcat
-namespace import ::msgcat::mc
-## And eventually load the actual message catalog
-::msgcat::mcload $gitk_msgsdir
-
-catch {source ~/.gitk}
-
-font create optionfont -family sans-serif -size -12
-
-parsefont mainfont $mainfont
-eval font create mainfont [fontflags mainfont]
-eval font create mainfontbold [fontflags mainfont 1]
-
-parsefont textfont $textfont
-eval font create textfont [fontflags textfont]
-eval font create textfontbold [fontflags textfont 1]
-
-parsefont uifont $uifont
-eval font create uifont [fontflags uifont]
-
-setui $uicolor
-
-setoptions
-
-# check that we can find a .git directory somewhere...
-if {[catch {set gitdir [gitdir]}]} {
- show_error {} . [mc "Cannot find a git repository here."]
- exit 1
-}
-if {![file isdirectory $gitdir]} {
- show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
- exit 1
-}
-
-set selecthead {}
-set selectheadid {}
-
-set revtreeargs {}
-set cmdline_files {}
-set i 0
-set revtreeargscmd {}
-foreach arg $argv {
- switch -glob -- $arg {
- "" { }
- "--" {
- set cmdline_files [lrange $argv [expr {$i + 1}] end]
- break
- }
- "--select-commit=*" {
- set selecthead [string range $arg 16 end]
- }
- "--argscmd=*" {
- set revtreeargscmd [string range $arg 10 end]
- }
- default {
- lappend revtreeargs $arg
- }
+ # First check that Tcl/Tk is recent enough
+ if {[catch {package require Tk 8.4} err]} {
+ return -code error "Sorry, gitk cannot run with this version of\
+ Tcl/Tk.\nGitk requires at least Tcl/Tk 8.4."
}
- incr i
-}
-if {$selecthead eq "HEAD"} {
- set selecthead {}
-}
+ ## For msgcat loading, first locate the installation location.
+ if { [info exists ::env(GITK_MSGSDIR)] } {
+ ## Msgsdir was manually set in the environment.
+ variable gitk_msgsdir $::env(GITK_MSGSDIR)
+ } else {
+ ## Let's guess the prefix from argv0.
+ set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
+ set gitk_libdir [file join $gitk_prefix share gitk lib]
+ variable gitk_msgsdir [file join $gitk_libdir msgs]
+ }
+
+ ## Internationalization (i18n) through msgcat and gettext. See
+ ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
+ package require msgcat
+ namespace import ::msgcat::mc
+ ## And eventually load the actual message catalog
+ ::msgcat::mcload $gitk_msgsdir
+
+ # continue initialization with 8.4+
+ eval init $args
+
+ tkwait window .
+}
+
+# Initialization code requires 8.4+ for eval/byte-compilation.
+proc init {args} {
+ global env argv0 tk_version
+
+ # Hide the main window until all is ready
+ wm withdraw .
+
+ # defaults...
+ variable wrcomcmd "git diff-tree --stdin -p --pretty"
+
+ set gitencoding {}
+ catch {
+ set gitencoding [exec git config --get i18n.commitencoding]
+ }
+ catch {
+ set gitencoding [exec git config --get i18n.logoutputencoding]
+ }
+ if {$gitencoding == ""} {
+ set gitencoding "utf-8"
+ }
+ variable tclencoding [tcl_encoding $gitencoding]
+ if {$tclencoding == {}} {
+ puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
+ }
+
+ variable gui_encoding [encoding system]
+ catch {
+ set enc [exec git config --get gui.encoding]
+ if {$enc ne {}} {
+ set tclenc [tcl_encoding $enc]
+ if {$tclenc ne {}} {
+ set gui_encoding $tclenc
+ } else {
+ puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
+ }
+ }
+ }
+
+ if {[tk windowingsystem] eq "aqua"} {
+ variable mainfont {{Lucida Grande} 9}
+ variable textfont {Monaco 9}
+ variable uifont {{Lucida Grande} 9 bold}
+ } else {
+ variable mainfont {Helvetica 9}
+ variable textfont {Courier 9}
+ variable uifont {Helvetica 9 bold}
+ }
+ variable tabstop 8
+ variable findmergefiles 0
+ variable maxgraphpct 50
+ variable maxwidth 16
+ variable revlistorder 0
+ variable fastdate 0
+ variable uparrowlen 5
+ variable downarrowlen 5
+ variable mingaplen 100
+ variable cmitmode "patch"
+ variable wrapcomment "none"
+ variable showneartags 1
+ variable hideremotes 0
+ variable maxrefs 20
+ variable maxlinelen 200
+ variable showlocalchanges 1
+ variable limitdiffs 1
+ variable datetimeformat "%Y-%m-%d %H:%M:%S"
+ variable autoselect 1
+ variable perfile_attrs 0
+ variable want_ttk 1
+
+ if {[tk windowingsystem] eq "aqua"} {
+ variable extdifftool "opendiff"
+ } else {
+ variable extdifftool "meld"
+ }
-if {$i >= [llength $argv] && $revtreeargs ne {}} {
- # no -- on command line, but some arguments (other than --argscmd)
- if {[catch {
- set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
- set cmdline_files [split $f "\n"]
- set n [llength $cmdline_files]
- set revtreeargs [lrange $revtreeargs 0 end-$n]
- # Unfortunately git rev-parse doesn't produce an error when
- # something is both a revision and a filename. To be consistent
- # with git log and git rev-list, check revtreeargs for filenames.
- foreach arg $revtreeargs {
- if {[file exists $arg]} {
- show_error {} . [mc "Ambiguous argument '%s': both revision\
+ variable colors {green red blue magenta darkgrey brown orange}
+ if {[tk windowingsystem] eq "win32"} {
+ variable uicolor SystemButtonFace
+ variable bgcolor SystemWindow
+ variable fgcolor SystemButtonText
+ variable selectbgcolor SystemHighlight
+ } else {
+ variable uicolor grey85
+ variable bgcolor white
+ variable fgcolor black
+ variable selectbgcolor gray85
+ }
+ variable diffcolors {red "#00a000" blue}
+ variable diffcontext 3
+ variable ignorespace 0
+ variable markbgcolor "#e0e0ff"
+
+ variable circlecolors {white blue gray blue blue}
+
+ # button for popping up context menus
+ if {[tk windowingsystem] eq "aqua"} {
+ variable ctxbut <Button-2>
+ } else {
+ variable ctxbut <Button-3>
+ }
+
+ create_bitmaps
+ init_font_chooser
+ catch {uplevel #0 [list source ~/.gitk]}
+
+ font create optionfont -family sans-serif -size -12
+
+ parsefont mainfont $mainfont
+ eval font create mainfont [fontflags mainfont]
+ eval font create mainfontbold [fontflags mainfont 1]
+
+ parsefont textfont $textfont
+ eval font create textfont [fontflags textfont]
+ eval font create textfontbold [fontflags textfont 1]
+
+ parsefont uifont $uifont
+ eval font create uifont [fontflags uifont]
+
+ setui $uicolor
+
+ setoptions
+
+ # check that we can find a .git directory somewhere...
+ if {[catch {set gitdir [gitdir]}]} {
+ show_error {} . [mc "Cannot find a git repository here."]
+ exit 1
+ }
+ if {![file isdirectory $gitdir]} {
+ show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
+ exit 1
+ }
+
+ variable selecthead {}
+ variable selectheadid {}
+
+ variable revtreeargs {}
+ set cmdline_files {}
+ set i 0
+ set revtreeargscmd {}
+ foreach arg $args {
+ switch -glob -- $arg {
+ "" { }
+ "--" {
+ set cmdline_files [lrange $args [expr {$i + 1}] end]
+ break
+ }
+ "--select-commit=*" {
+ set selecthead [string range $arg 16 end]
+ }
+ "--argscmd=*" {
+ set revtreeargscmd [string range $arg 10 end]
+ }
+ default {
+ lappend revtreeargs $arg
+ }
+ }
+ incr i
+ }
+
+ if {$selecthead eq "HEAD"} {
+ set selecthead {}
+ }
+
+ if {$i >= [llength $args] && $revtreeargs ne {}} {
+ # no -- on command line, but some arguments (other than --argscmd)
+ if {[catch {
+ set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
+ set cmdline_files [split $f "\n"]
+ set n [llength $cmdline_files]
+ set revtreeargs [lrange $revtreeargs 0 end-$n]
+ # Unfortunately git rev-parse doesn't produce an error when
+ # something is both a revision and a filename. To be consistent
+ # with git log and git rev-list, check revtreeargs for filenames.
+ foreach arg $revtreeargs {
+ if {[file exists $arg]} {
+ show_error {} . [mc "Ambiguous argument '%s': both revision\
and filename" $arg]
- exit 1
- }
- }
- } err]} {
- # unfortunately we get both stdout and stderr in $err,
- # so look for "fatal:".
- set i [string first "fatal:" $err]
- if {$i > 0} {
- set err [string range $err [expr {$i + 6}] end]
- }
- show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
- exit 1
+ exit 1
+ }
+ }
+ } err]} {
+ # unfortunately we get both stdout and stderr in $err,
+ # so look for "fatal:".
+ set i [string first "fatal:" $err]
+ if {$i > 0} {
+ set err [string range $err [expr {$i + 6}] end]
+ }
+ show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
+ exit 1
+ }
}
-}
-set nullid "0000000000000000000000000000000000000000"
-set nullid2 "0000000000000000000000000000000000000001"
-set nullfile "/dev/null"
-
-set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
-if {![info exists have_ttk]} {
- set have_ttk [llength [info commands ::ttk::style]]
-}
-set use_ttk [expr {$have_ttk && $want_ttk}]
-set NS [expr {$use_ttk ? "ttk" : ""}]
-
-set git_version [join [lrange [split [lindex [exec git version] end] .] 0 2] .]
-
-set runq {}
-set history {}
-set historyindex 0
-set fh_serial 0
-set nhl_names {}
-set highlight_paths {}
-set findpattern {}
-set searchdirn -forwards
-set boldids {}
-set boldnameids {}
-set diffelide {0 0}
-set markingmatches 0
-set linkentercount 0
-set need_redisplay 0
-set nrows_drawn 0
-set firsttabstop 0
-
-set nextviewnum 1
-set curview 0
-set selectedview 0
-set selectedhlview [mc "None"]
-set highlight_related [mc "None"]
-set highlight_files {}
-set viewfiles(0) {}
-set viewperm(0) 0
-set viewargs(0) {}
-set viewargscmd(0) {}
-
-set selectedline {}
-set numcommits 0
-set loginstance 0
-set cmdlineok 0
-set stopped 0
-set stuffsaved 0
-set patchnum 0
-set lserial 0
-set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
-setcoords
-makewindow
-catch {
- image create photo gitlogo -width 16 -height 16
-
- image create photo gitlogominus -width 4 -height 2
- gitlogominus put #C00000 -to 0 0 4 2
- gitlogo copy gitlogominus -to 1 5
- gitlogo copy gitlogominus -to 6 5
- gitlogo copy gitlogominus -to 11 5
- image delete gitlogominus
-
- image create photo gitlogoplus -width 4 -height 4
- gitlogoplus put #008000 -to 1 0 3 4
- gitlogoplus put #008000 -to 0 1 4 3
- gitlogo copy gitlogoplus -to 1 9
- gitlogo copy gitlogoplus -to 6 9
- gitlogo copy gitlogoplus -to 11 9
- image delete gitlogoplus
-
- image create photo gitlogo32 -width 32 -height 32
- gitlogo32 copy gitlogo -zoom 2 2
-
- wm iconphoto . -default gitlogo gitlogo32
-}
-# wait for the window to become visible
-tkwait visibility .
-wm title . "[file tail $argv0]: [file tail [pwd]]"
-update
-readrefs
-
-if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
- # create a view for the files/dirs specified on the command line
- set curview 1
- set selectedview 1
- set nextviewnum 2
- set viewname(1) [mc "Command line"]
- set viewfiles(1) $cmdline_files
- set viewargs(1) $revtreeargs
- set viewargscmd(1) $revtreeargscmd
- set viewperm(1) 0
- set vdatemode(1) 0
- addviewmenu 1
- .bar.view entryconf [mca "Edit view..."] -state normal
- .bar.view entryconf [mca "Delete view"] -state normal
-}
-
-if {[info exists permviews]} {
- foreach v $permviews {
- set n $nextviewnum
- incr nextviewnum
- set viewname($n) [lindex $v 0]
- set viewfiles($n) [lindex $v 1]
- set viewargs($n) [lindex $v 2]
- set viewargscmd($n) [lindex $v 3]
- set viewperm($n) 1
- addviewmenu $n
- }
-}
+ variable nullid "0000000000000000000000000000000000000000"
+ variable nullid2 "0000000000000000000000000000000000000001"
+ variable nullfile "/dev/null"
+
+ variable have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
+ if {![info exists have_ttk]} {
+ variable have_ttk [llength [info commands ::ttk::style]]
+ }
+ variable use_ttk [expr {$have_ttk && $want_ttk}]
+ variable NS [expr {$use_ttk ? "ttk" : ""}]
+
+ variable git_version [join [lrange [split [lindex [exec git version] end] .] 0 2] .]
+
+ variable runq {}
+ variable history {}
+ variable historyindex 0
+ variable fh_serial 0
+ variable nhl_names {}
+ variable highlight_paths {}
+ variable findpattern {}
+ variable searchdirn -forwards
+ variable boldids {}
+ variable boldnameids {}
+ variable diffelide {0 0}
+ variable markingmatches 0
+ variable linkentercount 0
+ variable need_redisplay 0
+ variable nrows_drawn 0
+ variable firsttabstop 0
+
+ variable nextviewnum 1
+ variable curview 0
+ variable selectedview 0
+ variable selectedhlview [mc "None"]
+ variable highlight_related [mc "None"]
+ variable highlight_files {}
+
+ global viewfiles viewperm viewargs viewargscmd
+ global viewcomplete viewactive viewname viewinstances
+ global viewfiles viewargs viewargscmd viewperm
+ global vdatemode
+
+ set viewfiles(0) {}
+ set viewperm(0) 0
+ set viewargs(0) {}
+ set viewargscmd(0) {}
+
+ variable selectedline {}
+ variable numcommits 0
+ variable loginstance 0
+ variable cmdlineok 0
+ variable stopped 0
+ variable stuffsaved 0
+ variable patchnum 0
+ variable lserial 0
+ variable isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
+ setcoords
+ makewindow
+ catch {
+ image create photo gitlogo -width 16 -height 16
+
+ image create photo gitlogominus -width 4 -height 2
+ gitlogominus put #C00000 -to 0 0 4 2
+ gitlogo copy gitlogominus -to 1 5
+ gitlogo copy gitlogominus -to 6 5
+ gitlogo copy gitlogominus -to 11 5
+ image delete gitlogominus
+
+ image create photo gitlogoplus -width 4 -height 4
+ gitlogoplus put #008000 -to 1 0 3 4
+ gitlogoplus put #008000 -to 0 1 4 3
+ gitlogo copy gitlogoplus -to 1 9
+ gitlogo copy gitlogoplus -to 6 9
+ gitlogo copy gitlogoplus -to 11 9
+ image delete gitlogoplus
+
+ image create photo gitlogo32 -width 32 -height 32
+ gitlogo32 copy gitlogo -zoom 2 2
+
+ wm iconphoto . -default gitlogo gitlogo32
+ }
+ # wait for the window to become visible
+ wm deiconify .
+ tkwait visibility .
+ wm title . "[file tail $argv0]: [file tail [pwd]]"
+ update
+ readrefs
-if {[tk windowingsystem] eq "win32"} {
- focus -force .
-}
+ if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
+ # create a view for the files/dirs specified on the command line
+ set curview 1
+ set selectedview 1
+ set nextviewnum 2
+ set viewname(1) [mc "Command line"]
+ set viewfiles(1) $cmdline_files
+ set viewargs(1) $revtreeargs
+ set viewargscmd(1) $revtreeargscmd
+ set viewperm(1) 0
+ set vdatemode(1) 0
+ addviewmenu 1
+ .bar.view entryconf [mca "Edit view..."] -state normal
+ .bar.view entryconf [mca "Delete view"] -state normal
+ }
+
+ if {[info exists ::permviews]} {
+ foreach v $::permviews {
+ set n $nextviewnum
+ incr nextviewnum
+ set viewname($n) [lindex $v 0]
+ set viewfiles($n) [lindex $v 1]
+ set viewargs($n) [lindex $v 2]
+ set viewargscmd($n) [lindex $v 3]
+ set viewperm($n) 1
+ addviewmenu $n
+ }
+ }
-getcommits {}
+ if {[tk windowingsystem] eq "win32"} {
+ focus -force .
+ bind . <Control-F2> {console show}
+ }
+
+ getcommits {}
+}
+
+if {!$tcl_interactive} {
+ if {[llength [package provide tcltest]]>0} { return }
+ if {![info exists initialized]} {
+ set initialized 1
+ package require Tk
+ wm withdraw .
+ set r [catch [linsert $argv 0 main] err]
+ if {$r} {
+ if {[string equal $tcl_platform(platform) "windows"]} {
+ tk_messageBox -icon error -title "Gitk error" \
+ -message $err
+ } else {
+ puts stderr $err
+ }
+ }
+ exit $r
+ }
+}
\ No newline at end of file
projects / gitk / commitdiff