contrib/hgk
author Patrick Mezard <pmezard@gmail.com>
Fri, 05 Oct 2007 23:40:33 +0200
changeset 5395 e73a83af7926
parent 5394 0ad0e97345eb
child 5417 b8872655f951
permissions -rwxr-xr-x
hgk: add basic usage and configuration documentation
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1361
f6d73b26dbdb contrib/hgk: remove hardcoded path to Wish
TK Soh <teekaysoh@yahoo.com>
parents: 1340
diff changeset
     1
#!/usr/bin/env wish
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
     2
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
     3
# Copyright (C) 2005 Paul Mackerras.  All rights reserved.
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
     4
# This program is free software; it may be used, copied, modified
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
     5
# and distributed under the terms of the GNU General Public Licence,
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
     6
# either version 2, or (at your option) any later version.
5395
e73a83af7926 hgk: add basic usage and configuration documentation
Patrick Mezard <pmezard@gmail.com>
parents: 5394
diff changeset
     7
#
e73a83af7926 hgk: add basic usage and configuration documentation
Patrick Mezard <pmezard@gmail.com>
parents: 5394
diff changeset
     8
# See hgk.py for extension usage and configuration.
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
     9
4969
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    10
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    11
# Modified version of Tip 171:
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    12
# http://www.tcl.tk/cgi-bin/tct/tip/171.html
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    13
#
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    14
# The in_mousewheel global was added to fix strange reentrancy issues.
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    15
# The whole snipped is activated only under windows, mouse wheel
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    16
# bindings working already under MacOSX and Linux.
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    17
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    18
if {[tk windowingsystem] eq "win32"} {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    19
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    20
set mw_classes [list Text Listbox Table TreeCtrl]
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    21
   foreach class $mw_classes { bind $class <MouseWheel> {} }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    22
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    23
set in_mousewheel 0
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    24
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    25
proc ::tk::MouseWheel {wFired X Y D {shifted 0}} {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    26
    global in_mousewheel
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    27
    if { $in_mousewheel != 0 } { return }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    28
    # Set event to check based on call
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    29
    set evt "<[expr {$shifted?{Shift-}:{}}]MouseWheel>"
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    30
    # do not double-fire in case the class already has a binding
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    31
    if {[bind [winfo class $wFired] $evt] ne ""} { return }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    32
    # obtain the window the mouse is over
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    33
    set w [winfo containing $X $Y]
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    34
    # if we are outside the app, try and scroll the focus widget
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    35
    if {![winfo exists $w]} { catch {set w [focus]} }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    36
    if {[winfo exists $w]} {
5143
d4fa6bafc43a Remove trailing spaces, fix indentation
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4969
diff changeset
    37
4969
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    38
        if {[bind $w $evt] ne ""} {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    39
            # Awkward ... this widget has a MouseWheel binding, but to
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    40
            # trigger successfully in it, we must give it focus.
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    41
            catch {focus} old
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    42
            if {$w ne $old} { focus $w }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    43
            set in_mousewheel 1
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    44
            event generate $w $evt -rootx $X -rooty $Y -delta $D
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    45
            set in_mousewheel 0
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    46
            if {$w ne $old} { focus $old }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    47
            return
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    48
        }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    49
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    50
        # aqua and x11/win32 have different delta handling
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    51
        if {[tk windowingsystem] ne "aqua"} {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    52
            set delta [expr {- ($D / 30)}]
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    53
        } else {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    54
            set delta [expr {- ($D)}]
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    55
        }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    56
        # scrollbars have different call conventions
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    57
        if {[string match "*Scrollbar" [winfo class $w]]} {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    58
            catch {tk::ScrollByUnits $w \
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    59
                       [string index [$w cget -orient] 0] $delta}
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    60
        } else {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    61
            set cmd [list $w [expr {$shifted ? "xview" : "yview"}] \
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    62
                         scroll $delta units]
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    63
            # Walking up to find the proper widget (handles cases like
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    64
            # embedded widgets in a canvas)
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    65
            while {[catch $cmd] && [winfo toplevel $w] ne $w} {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    66
                set w [winfo parent $w]
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    67
            }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    68
        }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    69
    }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    70
}
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    71
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    72
bind all <MouseWheel> [list ::tk::MouseWheel %W %X %Y %D 0]
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    73
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    74
# end of win32 section
5143
d4fa6bafc43a Remove trailing spaces, fix indentation
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4969
diff changeset
    75
}
4969
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    76
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    77
5392
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
    78
# Unify right mouse button handling.
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
    79
# See "mouse buttons on macintosh" thread on comp.lang.tcl
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
    80
if {[tk windowingsystem] eq "aqua"} {
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
    81
    event add <<B3>> <Control-ButtonPress-1>
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
    82
    event add <<B3>> <Button-2>
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
    83
} else {
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
    84
    event add <<B3>> <Button-3>
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
    85
}
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
    86
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
    87
proc gitdir {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
    88
    global env
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
    89
    if {[info exists env(GIT_DIR)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
    90
	return $env(GIT_DIR)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
    91
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
    92
	return ".hg"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
    93
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
    94
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
    95
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
    96
proc getcommits {rargs} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
    97
    global commits commfd phase canv mainfont env
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
    98
    global startmsecs nextupdate ncmupdate
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
    99
    global ctext maincursor textcursor leftover
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   100
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   101
    # check that we can find a .git directory somewhere...
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   102
    set gitdir [gitdir]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   103
    if {![file isdirectory $gitdir]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   104
	error_popup "Cannot find the git directory \"$gitdir\"."
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   105
	exit 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   106
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   107
    set commits {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   108
    set phase getcommits
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   109
    set startmsecs [clock clicks -milliseconds]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   110
    set nextupdate [expr $startmsecs + 100]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   111
    set ncmupdate 1
3093
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   112
    set limit 0
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   113
    set revargs {}
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   114
    for {set i 0} {$i < [llength $rargs]} {incr i} {
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   115
	set opt [lindex $rargs $i]
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   116
	if {$opt == "--limit"} {
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   117
	    incr i
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   118
	    set limit [lindex $rargs $i]
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   119
	} else {
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   120
	    lappend revargs $opt
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   121
	}
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   122
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   123
    if [catch {
3093
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   124
	set parse_args [concat --default HEAD $revargs]
4740
e1d1b22bab57 Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4688
diff changeset
   125
	set parse_temp [eval exec {$env(HG)} --config ui.report_untrusted=false debug-rev-parse $parse_args]
3940
a33ddd20105c hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents: 3093
diff changeset
   126
	regsub -all "\r\n" $parse_temp "\n" parse_temp
a33ddd20105c hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents: 3093
diff changeset
   127
	set parsed_args [split $parse_temp "\n"]
3093
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   128
    } err] {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   129
	# if git-rev-parse failed for some reason...
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   130
	if {$rargs == {}} {
3093
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   131
	    set revargs HEAD
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   132
	}
3093
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   133
	set parsed_args $revargs
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   134
    }
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   135
    if {$limit > 0} {
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   136
	set parsed_args [concat -n $limit $parsed_args]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   137
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   138
    if [catch {
4740
e1d1b22bab57 Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4688
diff changeset
   139
	set commfd [open "|{$env(HG)} --config ui.report_untrusted=false debug-rev-list --header --topo-order --parents $parsed_args" r]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   140
    } err] {
1278
6a0d373d3126 hgit -> hgk.py
mpm@selenic.com
parents: 1240
diff changeset
   141
	puts stderr "Error executing hg debug-rev-list: $err"
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   142
	exit 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   143
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   144
    set leftover {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   145
    fconfigure $commfd -blocking 0 -translation lf
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   146
    fileevent $commfd readable [list getcommitlines $commfd]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   147
    $canv delete all
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   148
    $canv create text 3 3 -anchor nw -text "Reading commits..." \
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   149
	-font $mainfont -tags textitems
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   150
    . config -cursor watch
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   151
    settextcursor watch
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   152
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   153
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   154
proc getcommitlines {commfd}  {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   155
    global commits parents cdate children
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   156
    global commitlisted phase commitinfo nextupdate
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   157
    global stopped redisplaying leftover
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   158
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   159
    set stuff [read $commfd]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   160
    if {$stuff == {}} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   161
	if {![eof $commfd]} return
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   162
	# set it blocking so we wait for the process to terminate
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   163
	fconfigure $commfd -blocking 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   164
	if {![catch {close $commfd} err]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   165
	    after idle finishcommits
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   166
	    return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   167
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   168
	if {[string range $err 0 4] == "usage"} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   169
	    set err \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   170
{Gitk: error reading commits: bad arguments to git-rev-list.
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   171
(Note: arguments to gitk are passed to git-rev-list
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   172
to allow selection of commits to be displayed.)}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   173
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   174
	    set err "Error reading commits: $err"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   175
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   176
	error_popup $err
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   177
	exit 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   178
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   179
    set start 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   180
    while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   181
	set i [string first "\0" $stuff $start]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   182
	if {$i < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   183
	    append leftover [string range $stuff $start end]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   184
	    return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   185
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   186
	set cmit [string range $stuff $start [expr {$i - 1}]]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   187
	if {$start == 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   188
	    set cmit "$leftover$cmit"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   189
	    set leftover {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   190
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   191
	set start [expr {$i + 1}]
3940
a33ddd20105c hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents: 3093
diff changeset
   192
	regsub -all "\r\n" $cmit "\n" cmit
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   193
	set j [string first "\n" $cmit]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   194
	set ok 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   195
	if {$j >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   196
	    set ids [string range $cmit 0 [expr {$j - 1}]]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   197
	    set ok 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   198
	    foreach id $ids {
3059
3dab573a4330 hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents: 2297
diff changeset
   199
		if {![regexp {^[0-9a-f]{12}$} $id]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   200
		    set ok 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   201
		    break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   202
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   203
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   204
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   205
	if {!$ok} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   206
	    set shortcmit $cmit
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   207
	    if {[string length $shortcmit] > 80} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   208
		set shortcmit "[string range $shortcmit 0 80]..."
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   209
	    }
1278
6a0d373d3126 hgit -> hgk.py
mpm@selenic.com
parents: 1240
diff changeset
   210
	    error_popup "Can't parse hg debug-rev-list output: {$shortcmit}"
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   211
	    exit 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   212
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   213
	set id [lindex $ids 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   214
	set olds [lrange $ids 1 end]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   215
	set cmit [string range $cmit [expr {$j + 1}] end]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   216
	lappend commits $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   217
	set commitlisted($id) 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   218
	parsecommit $id $cmit 1 [lrange $ids 1 end]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   219
	drawcommit $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   220
	if {[clock clicks -milliseconds] >= $nextupdate} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   221
	    doupdate 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   222
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   223
	while {$redisplaying} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   224
	    set redisplaying 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   225
	    if {$stopped == 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   226
		set stopped 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   227
		set phase "getcommits"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   228
		foreach id $commits {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   229
		    drawcommit $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   230
		    if {$stopped} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   231
		    if {[clock clicks -milliseconds] >= $nextupdate} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   232
			doupdate 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   233
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   234
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   235
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   236
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   237
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   238
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   239
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   240
proc doupdate {reading} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   241
    global commfd nextupdate numcommits ncmupdate
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   242
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   243
    if {$reading} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   244
	fileevent $commfd readable {}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   245
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   246
    update
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   247
    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   248
    if {$numcommits < 100} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   249
	set ncmupdate [expr {$numcommits + 1}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   250
    } elseif {$numcommits < 10000} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   251
	set ncmupdate [expr {$numcommits + 10}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   252
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   253
	set ncmupdate [expr {$numcommits + 100}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   254
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   255
    if {$reading} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   256
	fileevent $commfd readable [list getcommitlines $commfd]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   257
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   258
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   259
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   260
proc readcommit {id} {
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
   261
    global env
4740
e1d1b22bab57 Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4688
diff changeset
   262
    if [catch {set contents [exec $env(HG) --config ui.report_untrusted=false debug-cat-file commit $id]}] return
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   263
    parsecommit $id $contents 0 {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   264
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   265
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   266
proc parsecommit {id contents listed olds} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   267
    global commitinfo children nchildren parents nparents cdate ncleft
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   268
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   269
    set inhdr 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   270
    set comment {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   271
    set headline {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   272
    set auname {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   273
    set audate {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   274
    set comname {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   275
    set comdate {}
3092
d0fcce3728d1 hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents: 3059
diff changeset
   276
    set rev {}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   277
    if {![info exists nchildren($id)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   278
	set children($id) {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   279
	set nchildren($id) 0
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   280
	set ncleft($id) 0
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   281
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   282
    set parents($id) $olds
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   283
    set nparents($id) [llength $olds]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   284
    foreach p $olds {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   285
	if {![info exists nchildren($p)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   286
	    set children($p) [list $id]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   287
	    set nchildren($p) 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   288
	    set ncleft($p) 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   289
	} elseif {[lsearch -exact $children($p) $id] < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   290
	    lappend children($p) $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   291
	    incr nchildren($p)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   292
	    incr ncleft($p)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   293
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   294
    }
3940
a33ddd20105c hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents: 3093
diff changeset
   295
    regsub -all "\r\n" $contents "\n" contents
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   296
    foreach line [split $contents "\n"] {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   297
	if {$inhdr} {
2297
936b615eb44e Fix hg view if author's name contains unmatched quotes. (issue248)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 2058
diff changeset
   298
	    set line [split $line]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   299
	    if {$line == {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   300
		set inhdr 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   301
	    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   302
		set tag [lindex $line 0]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   303
		if {$tag == "author"} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   304
		    set x [expr {[llength $line] - 2}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   305
		    set audate [lindex $line $x]
2297
936b615eb44e Fix hg view if author's name contains unmatched quotes. (issue248)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 2058
diff changeset
   306
		    set auname [join [lrange $line 1 [expr {$x - 1}]]]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   307
		} elseif {$tag == "committer"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   308
		    set x [expr {[llength $line] - 2}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   309
		    set comdate [lindex $line $x]
2297
936b615eb44e Fix hg view if author's name contains unmatched quotes. (issue248)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 2058
diff changeset
   310
		    set comname [join [lrange $line 1 [expr {$x - 1}]]]
3092
d0fcce3728d1 hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents: 3059
diff changeset
   311
		} elseif {$tag == "revision"} {
d0fcce3728d1 hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents: 3059
diff changeset
   312
		    set rev [lindex $line 1]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   313
		}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   314
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   315
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   316
	    if {$comment == {}} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   317
		set headline [string trim $line]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   318
	    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   319
		append comment "\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   320
	    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   321
	    if {!$listed} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   322
		# git-rev-list indents the comment by 4 spaces;
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   323
		# if we got this via git-cat-file, add the indentation
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   324
		append comment "    "
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   325
	    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   326
	    append comment $line
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   327
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   328
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   329
    if {$audate != {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   330
	set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   331
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   332
    if {$comdate != {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   333
	set cdate($id) $comdate
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   334
	set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   335
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   336
    set commitinfo($id) [list $headline $auname $audate \
3092
d0fcce3728d1 hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents: 3059
diff changeset
   337
			     $comname $comdate $comment $rev]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   338
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   339
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   340
proc readrefs {} {
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
   341
    global tagids idtags headids idheads tagcontents env
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   342
4740
e1d1b22bab57 Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4688
diff changeset
   343
    set tags [exec $env(HG) --config ui.report_untrusted=false tags]
3940
a33ddd20105c hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents: 3093
diff changeset
   344
    regsub -all "\r\n" $tags "\n" tags
a33ddd20105c hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents: 3093
diff changeset
   345
    set lines [split $tags "\n"]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   346
    foreach f $lines {
4502
1774c037fbd2 hgk: display tags that contain spaces
TK Soh <teekaysoh@yahoo.com>
parents: 4501
diff changeset
   347
	regexp {(\S+)$} $f full
1774c037fbd2 hgk: display tags that contain spaces
TK Soh <teekaysoh@yahoo.com>
parents: 4501
diff changeset
   348
	regsub {\s+(\S+)$} $f "" direct
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   349
	set sha [split $full ':']
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   350
	set tag [lindex $sha 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   351
	lappend tagids($direct) $tag
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   352
	lappend idtags($tag) $direct
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   353
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   354
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   355
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   356
proc readotherrefs {base dname excl} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   357
    global otherrefids idotherrefs
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   358
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   359
    set git [gitdir]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   360
    set files [glob -nocomplain -types f [file join $git $base *]]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   361
    foreach f $files {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   362
	catch {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   363
	    set fd [open $f r]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   364
	    set line [read $fd 40]
3059
3dab573a4330 hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents: 2297
diff changeset
   365
	    if {[regexp {^[0-9a-f]{12}} $line id]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   366
		set name "$dname[file tail $f]"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   367
		set otherrefids($name) $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   368
		lappend idotherrefs($id) $name
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   369
	    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   370
	    close $fd
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   371
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   372
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   373
    set dirs [glob -nocomplain -types d [file join $git $base *]]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   374
    foreach d $dirs {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   375
	set dir [file tail $d]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   376
	if {[lsearch -exact $excl $dir] >= 0} continue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   377
	readotherrefs [file join $base $dir] "$dname$dir/" {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   378
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   379
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   380
4968
713426631adf hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents: 4741
diff changeset
   381
proc allcansmousewheel {delta} {
713426631adf hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents: 4741
diff changeset
   382
    set delta [expr -5*(int($delta)/abs($delta))]
713426631adf hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents: 4741
diff changeset
   383
    allcanvs yview scroll $delta units
713426631adf hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents: 4741
diff changeset
   384
}
713426631adf hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents: 4741
diff changeset
   385
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   386
proc error_popup msg {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   387
    set w .error
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   388
    toplevel $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   389
    wm transient $w .
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   390
    message $w.m -text $msg -justify center -aspect 400
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   391
    pack $w.m -side top -fill x -padx 20 -pady 20
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   392
    button $w.ok -text OK -command "destroy $w"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   393
    pack $w.ok -side bottom -fill x
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   394
    bind $w <Visibility> "grab $w; focus $w"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   395
    tkwait window $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   396
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   397
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   398
proc makewindow {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   399
    global canv canv2 canv3 linespc charspc ctext cflist textfont
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   400
    global findtype findtypemenu findloc findstring fstring geometry
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   401
    global entries sha1entry sha1string sha1but
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   402
    global maincursor textcursor curtextcursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   403
    global rowctxmenu gaudydiff mergemax
5394
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
   404
    global hgvdiff
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   405
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   406
    menu .bar
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   407
    .bar add cascade -label "File" -menu .bar.file
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   408
    menu .bar.file
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   409
    .bar.file add command -label "Reread references" -command rereadrefs
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   410
    .bar.file add command -label "Quit" -command doquit
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   411
    menu .bar.help
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   412
    .bar add cascade -label "Help" -menu .bar.help
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   413
    .bar.help add command -label "About gitk" -command about
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   414
    . configure -menu .bar
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   415
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   416
    if {![info exists geometry(canv1)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   417
	set geometry(canv1) [expr 45 * $charspc]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   418
	set geometry(canv2) [expr 30 * $charspc]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   419
	set geometry(canv3) [expr 15 * $charspc]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   420
	set geometry(canvh) [expr 25 * $linespc + 4]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   421
	set geometry(ctextw) 80
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   422
	set geometry(ctexth) 30
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   423
	set geometry(cflistw) 30
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   424
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   425
    panedwindow .ctop -orient vertical
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   426
    if {[info exists geometry(width)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   427
	.ctop conf -width $geometry(width) -height $geometry(height)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   428
	set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   429
	set geometry(ctexth) [expr {($texth - 8) /
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   430
				    [font metrics $textfont -linespace]}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   431
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   432
    frame .ctop.top
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   433
    frame .ctop.top.bar
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   434
    pack .ctop.top.bar -side bottom -fill x
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   435
    set cscroll .ctop.top.csb
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   436
    scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   437
    pack $cscroll -side right -fill y
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   438
    panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   439
    pack .ctop.top.clist -side top -fill both -expand 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   440
    .ctop add .ctop.top
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   441
    set canv .ctop.top.clist.canv
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   442
    canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   443
	-bg white -bd 0 \
4501
b2338c0cf468 hgk: added -selectbackground grey to canvases
Bela Babik <teki321@gmail.com>
parents: 3940
diff changeset
   444
	-yscrollincr $linespc -yscrollcommand "$cscroll set" -selectbackground grey
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   445
    .ctop.top.clist add $canv
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   446
    set canv2 .ctop.top.clist.canv2
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   447
    canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
4501
b2338c0cf468 hgk: added -selectbackground grey to canvases
Bela Babik <teki321@gmail.com>
parents: 3940
diff changeset
   448
	-bg white -bd 0 -yscrollincr $linespc -selectbackground grey
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   449
    .ctop.top.clist add $canv2
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   450
    set canv3 .ctop.top.clist.canv3
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   451
    canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
4501
b2338c0cf468 hgk: added -selectbackground grey to canvases
Bela Babik <teki321@gmail.com>
parents: 3940
diff changeset
   452
	-bg white -bd 0 -yscrollincr $linespc -selectbackground grey
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   453
    .ctop.top.clist add $canv3
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   454
    bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   455
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   456
    set sha1entry .ctop.top.bar.sha1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   457
    set entries $sha1entry
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   458
    set sha1but .ctop.top.bar.sha1label
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   459
    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   460
	-command gotocommit -width 8
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   461
    $sha1but conf -disabledforeground [$sha1but cget -foreground]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   462
    pack .ctop.top.bar.sha1label -side left
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   463
    entry $sha1entry -width 40 -font $textfont -textvariable sha1string
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   464
    trace add variable sha1string write sha1change
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   465
    pack $sha1entry -side left -pady 2
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   466
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   467
    image create bitmap bm-left -data {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   468
	#define left_width 16
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   469
	#define left_height 16
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   470
	static unsigned char left_bits[] = {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   471
	0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   472
	0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   473
	0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   474
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   475
    image create bitmap bm-right -data {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   476
	#define right_width 16
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   477
	#define right_height 16
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   478
	static unsigned char right_bits[] = {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   479
	0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   480
	0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   481
	0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   482
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   483
    button .ctop.top.bar.leftbut -image bm-left -command goback \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   484
	-state disabled -width 26
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   485
    pack .ctop.top.bar.leftbut -side left -fill y
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   486
    button .ctop.top.bar.rightbut -image bm-right -command goforw \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   487
	-state disabled -width 26
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   488
    pack .ctop.top.bar.rightbut -side left -fill y
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   489
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   490
    button .ctop.top.bar.findbut -text "Find" -command dofind
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   491
    pack .ctop.top.bar.findbut -side left
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   492
    set findstring {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   493
    set fstring .ctop.top.bar.findstring
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   494
    lappend entries $fstring
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   495
    entry $fstring -width 30 -font $textfont -textvariable findstring
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   496
    pack $fstring -side left -expand 1 -fill x
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   497
    set findtype Exact
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   498
    set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   499
			  findtype Exact IgnCase Regexp]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   500
    set findloc "All fields"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   501
    tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   502
	Comments Author Committer Files Pickaxe
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   503
    pack .ctop.top.bar.findloc -side right
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   504
    pack .ctop.top.bar.findtype -side right
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   505
    # for making sure type==Exact whenever loc==Pickaxe
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   506
    trace add variable findloc write findlocchange
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   507
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   508
    panedwindow .ctop.cdet -orient horizontal
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   509
    .ctop add .ctop.cdet
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   510
    frame .ctop.cdet.left
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   511
    set ctext .ctop.cdet.left.ctext
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   512
    text $ctext -bg white -state disabled -font $textfont \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   513
	-width $geometry(ctextw) -height $geometry(ctexth) \
1430
c91966c3bbf5 hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents: 1429
diff changeset
   514
	-yscrollcommand ".ctop.cdet.left.sb set" \
c91966c3bbf5 hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents: 1429
diff changeset
   515
	-xscrollcommand ".ctop.cdet.left.hb set" -wrap none
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   516
    scrollbar .ctop.cdet.left.sb -command "$ctext yview"
1430
c91966c3bbf5 hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents: 1429
diff changeset
   517
    scrollbar .ctop.cdet.left.hb -orient horizontal -command "$ctext xview"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   518
    pack .ctop.cdet.left.sb -side right -fill y
1430
c91966c3bbf5 hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents: 1429
diff changeset
   519
    pack .ctop.cdet.left.hb -side bottom -fill x
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   520
    pack $ctext -side left -fill both -expand 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   521
    .ctop.cdet add .ctop.cdet.left
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   522
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   523
    $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   524
    if {$gaudydiff} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   525
	$ctext tag conf hunksep -back blue -fore white
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   526
	$ctext tag conf d0 -back "#ff8080"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   527
	$ctext tag conf d1 -back green
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   528
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   529
	$ctext tag conf hunksep -fore blue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   530
	$ctext tag conf d0 -fore red
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   531
	$ctext tag conf d1 -fore "#00a000"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   532
	$ctext tag conf m0 -fore red
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   533
	$ctext tag conf m1 -fore blue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   534
	$ctext tag conf m2 -fore green
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   535
	$ctext tag conf m3 -fore purple
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   536
	$ctext tag conf m4 -fore brown
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   537
	$ctext tag conf mmax -fore darkgrey
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   538
	set mergemax 5
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   539
	$ctext tag conf mresult -font [concat $textfont bold]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   540
	$ctext tag conf msep -font [concat $textfont bold]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   541
	$ctext tag conf found -back yellow
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   542
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   543
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   544
    frame .ctop.cdet.right
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   545
    set cflist .ctop.cdet.right.cfiles
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   546
    listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   547
	-yscrollcommand ".ctop.cdet.right.sb set"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   548
    scrollbar .ctop.cdet.right.sb -command "$cflist yview"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   549
    pack .ctop.cdet.right.sb -side right -fill y
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   550
    pack $cflist -side left -fill both -expand 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   551
    .ctop.cdet add .ctop.cdet.right
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   552
    bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   553
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   554
    pack .ctop -side top -fill both -expand 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   555
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   556
    bindall <1> {selcanvline %W %x %y}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   557
    #bindall <B1-Motion> {selcanvline %W %x %y}
4968
713426631adf hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents: 4741
diff changeset
   558
    bindall <MouseWheel> "allcansmousewheel %D"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   559
    bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   560
    bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   561
    bindall <2> "allcanvs scan mark 0 %y"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   562
    bindall <B2-Motion> "allcanvs scan dragto 0 %y"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   563
    bind . <Key-Up> "selnextline -1"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   564
    bind . <Key-Down> "selnextline 1"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   565
    bind . <Key-Prior> "allcanvs yview scroll -1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   566
    bind . <Key-Next> "allcanvs yview scroll 1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   567
    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   568
    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   569
    bindkey <Key-space> "$ctext yview scroll 1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   570
    bindkey p "selnextline -1"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   571
    bindkey n "selnextline 1"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   572
    bindkey b "$ctext yview scroll -1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   573
    bindkey d "$ctext yview scroll 18 units"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   574
    bindkey u "$ctext yview scroll -18 units"
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   575
    bindkey / {findnext 1}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   576
    bindkey <Key-Return> {findnext 0}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   577
    bindkey ? findprev
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   578
    bindkey f nextfile
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   579
    bind . <Control-q> doquit
1429
45bd7925dceb Add control-w key binding to quit hgk.
Eric Bloodworth <ergosys@gmail.com>
parents: 1361
diff changeset
   580
    bind . <Control-w> doquit
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   581
    bind . <Control-f> dofind
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   582
    bind . <Control-g> {findnext 0}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   583
    bind . <Control-r> findprev
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   584
    bind . <Control-equal> {incrfont 1}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   585
    bind . <Control-KP_Add> {incrfont 1}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   586
    bind . <Control-minus> {incrfont -1}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   587
    bind . <Control-KP_Subtract> {incrfont -1}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   588
    bind $cflist <<ListboxSelect>> listboxsel
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   589
    bind . <Destroy> {savestuff %W}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   590
    bind . <Button-1> "click %W"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   591
    bind $fstring <Key-Return> dofind
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   592
    bind $sha1entry <Key-Return> gotocommit
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   593
    bind $sha1entry <<PasteSelection>> clearsha1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   594
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   595
    set maincursor [. cget -cursor]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   596
    set textcursor [$ctext cget -cursor]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   597
    set curtextcursor $textcursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   598
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   599
    set rowctxmenu .rowctxmenu
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   600
    menu $rowctxmenu -tearoff 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   601
    $rowctxmenu add command -label "Diff this -> selected" \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   602
	-command {diffvssel 0}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   603
    $rowctxmenu add command -label "Diff selected -> this" \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   604
	-command {diffvssel 1}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   605
    $rowctxmenu add command -label "Make patch" -command mkpatch
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   606
    $rowctxmenu add command -label "Create tag" -command mktag
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   607
    $rowctxmenu add command -label "Write commit to file" -command writecommit
5394
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
   608
    if { $hgvdiff ne "" } {
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
   609
	$rowctxmenu add command -label "Visual diff with parent" \
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
   610
	    -command {vdiff 1}
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
   611
	$rowctxmenu add command -label "Visual diff with selected" \
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
   612
	    -command {vdiff 0}
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
   613
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   614
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   615
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   616
# when we make a key binding for the toplevel, make sure
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   617
# it doesn't get triggered when that key is pressed in the
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   618
# find string entry widget.
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   619
proc bindkey {ev script} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   620
    global entries
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   621
    bind . $ev $script
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   622
    set escript [bind Entry $ev]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   623
    if {$escript == {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   624
	set escript [bind Entry <Key>]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   625
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   626
    foreach e $entries {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   627
	bind $e $ev "$escript; break"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   628
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   629
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   630
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   631
# set the focus back to the toplevel for any click outside
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   632
# the entry widgets
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   633
proc click {w} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   634
    global entries
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   635
    foreach e $entries {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   636
	if {$w == $e} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   637
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   638
    focus .
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   639
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   640
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   641
proc savestuff {w} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   642
    global canv canv2 canv3 ctext cflist mainfont textfont
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   643
    global stuffsaved findmergefiles gaudydiff maxgraphpct
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   644
    global maxwidth
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   645
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   646
    if {$stuffsaved} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   647
    if {![winfo viewable .]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   648
    catch {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   649
	set f [open "~/.gitk-new" w]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   650
	puts $f [list set mainfont $mainfont]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   651
	puts $f [list set textfont $textfont]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   652
	puts $f [list set findmergefiles $findmergefiles]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   653
	puts $f [list set gaudydiff $gaudydiff]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   654
	puts $f [list set maxgraphpct $maxgraphpct]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   655
	puts $f [list set maxwidth $maxwidth]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   656
	puts $f "set geometry(width) [winfo width .ctop]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   657
	puts $f "set geometry(height) [winfo height .ctop]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   658
	puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   659
	puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   660
	puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   661
	puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   662
	set wid [expr {([winfo width $ctext] - 8) \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   663
			   / [font measure $textfont "0"]}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   664
	puts $f "set geometry(ctextw) $wid"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   665
	set wid [expr {([winfo width $cflist] - 11) \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   666
			   / [font measure [$cflist cget -font] "0"]}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   667
	puts $f "set geometry(cflistw) $wid"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   668
	close $f
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   669
	file rename -force "~/.gitk-new" "~/.gitk"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   670
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   671
    set stuffsaved 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   672
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   673
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   674
proc resizeclistpanes {win w} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   675
    global oldwidth
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   676
    if [info exists oldwidth($win)] {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   677
	set s0 [$win sash coord 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   678
	set s1 [$win sash coord 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   679
	if {$w < 60} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   680
	    set sash0 [expr {int($w/2 - 2)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   681
	    set sash1 [expr {int($w*5/6 - 2)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   682
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   683
	    set factor [expr {1.0 * $w / $oldwidth($win)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   684
	    set sash0 [expr {int($factor * [lindex $s0 0])}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   685
	    set sash1 [expr {int($factor * [lindex $s1 0])}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   686
	    if {$sash0 < 30} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   687
		set sash0 30
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   688
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   689
	    if {$sash1 < $sash0 + 20} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   690
		set sash1 [expr $sash0 + 20]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   691
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   692
	    if {$sash1 > $w - 10} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   693
		set sash1 [expr $w - 10]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   694
		if {$sash0 > $sash1 - 20} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   695
		    set sash0 [expr $sash1 - 20]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   696
		}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   697
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   698
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   699
	$win sash place 0 $sash0 [lindex $s0 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   700
	$win sash place 1 $sash1 [lindex $s1 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   701
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   702
    set oldwidth($win) $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   703
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   704
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   705
proc resizecdetpanes {win w} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   706
    global oldwidth
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   707
    if [info exists oldwidth($win)] {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   708
	set s0 [$win sash coord 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   709
	if {$w < 60} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   710
	    set sash0 [expr {int($w*3/4 - 2)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   711
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   712
	    set factor [expr {1.0 * $w / $oldwidth($win)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   713
	    set sash0 [expr {int($factor * [lindex $s0 0])}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   714
	    if {$sash0 < 45} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   715
		set sash0 45
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   716
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   717
	    if {$sash0 > $w - 15} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   718
		set sash0 [expr $w - 15]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   719
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   720
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   721
	$win sash place 0 $sash0 [lindex $s0 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   722
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   723
    set oldwidth($win) $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   724
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   725
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   726
proc allcanvs args {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   727
    global canv canv2 canv3
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   728
    eval $canv $args
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   729
    eval $canv2 $args
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   730
    eval $canv3 $args
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   731
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   732
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   733
proc bindall {event action} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   734
    global canv canv2 canv3
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   735
    bind $canv $event $action
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   736
    bind $canv2 $event $action
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   737
    bind $canv3 $event $action
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   738
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   739
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   740
proc about {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   741
    set w .about
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   742
    if {[winfo exists $w]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   743
	raise $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   744
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   745
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   746
    toplevel $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   747
    wm title $w "About gitk"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   748
    message $w.m -text {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   749
Gitk version 1.2
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   750
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   751
Copyright © 2005 Paul Mackerras
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   752
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   753
Use and redistribute under the terms of the GNU General Public License} \
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   754
	    -justify center -aspect 400
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   755
    pack $w.m -side top -fill x -padx 20 -pady 20
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   756
    button $w.ok -text Close -command "destroy $w"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   757
    pack $w.ok -side bottom
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   758
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   759
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   760
proc assigncolor {id} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   761
    global commitinfo colormap commcolors colors nextcolor
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   762
    global parents nparents children nchildren
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   763
    global cornercrossings crossings
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   764
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   765
    if [info exists colormap($id)] return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   766
    set ncolors [llength $colors]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   767
    if {$nparents($id) <= 1 && $nchildren($id) == 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   768
	set child [lindex $children($id) 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   769
	if {[info exists colormap($child)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   770
	    && $nparents($child) == 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   771
	    set colormap($id) $colormap($child)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   772
	    return
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   773
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   774
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   775
    set badcolors {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   776
    if {[info exists cornercrossings($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   777
	foreach x $cornercrossings($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   778
	    if {[info exists colormap($x)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   779
		&& [lsearch -exact $badcolors $colormap($x)] < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   780
		lappend badcolors $colormap($x)
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   781
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   782
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   783
	if {[llength $badcolors] >= $ncolors} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   784
	    set badcolors {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   785
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   786
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   787
    set origbad $badcolors
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   788
    if {[llength $badcolors] < $ncolors - 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   789
	if {[info exists crossings($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   790
	    foreach x $crossings($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   791
		if {[info exists colormap($x)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   792
		    && [lsearch -exact $badcolors $colormap($x)] < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   793
		    lappend badcolors $colormap($x)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   794
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   795
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   796
	    if {[llength $badcolors] >= $ncolors} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   797
		set badcolors $origbad
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   798
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   799
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   800
	set origbad $badcolors
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   801
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   802
    if {[llength $badcolors] < $ncolors - 1} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   803
	foreach child $children($id) {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   804
	    if {[info exists colormap($child)]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   805
		&& [lsearch -exact $badcolors $colormap($child)] < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   806
		lappend badcolors $colormap($child)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   807
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   808
	    if {[info exists parents($child)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   809
		foreach p $parents($child) {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   810
		    if {[info exists colormap($p)]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   811
			&& [lsearch -exact $badcolors $colormap($p)] < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   812
			lappend badcolors $colormap($p)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   813
		    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   814
		}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   815
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   816
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   817
	if {[llength $badcolors] >= $ncolors} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   818
	    set badcolors $origbad
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   819
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   820
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   821
    for {set i 0} {$i <= $ncolors} {incr i} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   822
	set c [lindex $colors $nextcolor]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   823
	if {[incr nextcolor] >= $ncolors} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   824
	    set nextcolor 0
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   825
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   826
	if {[lsearch -exact $badcolors $c]} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   827
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   828
    set colormap($id) $c
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   829
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   830
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   831
proc initgraph {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   832
    global canvy canvy0 lineno numcommits nextcolor linespc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   833
    global mainline mainlinearrow sidelines
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   834
    global nchildren ncleft
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   835
    global displist nhyperspace
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   836
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   837
    allcanvs delete all
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   838
    set nextcolor 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   839
    set canvy $canvy0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   840
    set lineno -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   841
    set numcommits 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   842
    catch {unset mainline}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   843
    catch {unset mainlinearrow}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   844
    catch {unset sidelines}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   845
    foreach id [array names nchildren] {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   846
	set ncleft($id) $nchildren($id)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   847
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   848
    set displist {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   849
    set nhyperspace 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   850
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   851
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   852
proc bindline {t id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   853
    global canv
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   854
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   855
    $canv bind $t <Enter> "lineenter %x %y $id"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   856
    $canv bind $t <Motion> "linemotion %x %y $id"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   857
    $canv bind $t <Leave> "lineleave $id"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   858
    $canv bind $t <Button-1> "lineclick %x %y $id 1"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   859
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   860
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   861
proc drawlines {id xtra} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   862
    global mainline mainlinearrow sidelines lthickness colormap canv
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   863
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   864
    $canv delete lines.$id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   865
    if {[info exists mainline($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   866
	set t [$canv create line $mainline($id) \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   867
		   -width [expr {($xtra + 1) * $lthickness}] \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   868
		   -fill $colormap($id) -tags lines.$id \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   869
		   -arrow $mainlinearrow($id)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   870
	$canv lower $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   871
	bindline $t $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   872
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   873
    if {[info exists sidelines($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   874
	foreach ls $sidelines($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   875
	    set coords [lindex $ls 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   876
	    set thick [lindex $ls 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   877
	    set arrow [lindex $ls 2]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   878
	    set t [$canv create line $coords -fill $colormap($id) \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   879
		       -width [expr {($thick + $xtra) * $lthickness}] \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   880
		       -arrow $arrow -tags lines.$id]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   881
	    $canv lower $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   882
	    bindline $t $id
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   883
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   884
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   885
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   886
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   887
# level here is an index in displist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   888
proc drawcommitline {level} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   889
    global parents children nparents displist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   890
    global canv canv2 canv3 mainfont namefont canvy linespc
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   891
    global lineid linehtag linentag linedtag commitinfo
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   892
    global colormap numcommits currentparents dupparents
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   893
    global idtags idline idheads idotherrefs
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   894
    global lineno lthickness mainline mainlinearrow sidelines
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   895
    global commitlisted rowtextx idpos lastuse displist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   896
    global oldnlines olddlevel olddisplist
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   897
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   898
    incr numcommits
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   899
    incr lineno
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   900
    set id [lindex $displist $level]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   901
    set lastuse($id) $lineno
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   902
    set lineid($lineno) $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   903
    set idline($id) $lineno
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   904
    set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   905
    if {![info exists commitinfo($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   906
	readcommit $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   907
	if {![info exists commitinfo($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   908
	    set commitinfo($id) {"No commit information available"}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   909
	    set nparents($id) 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   910
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   911
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   912
    assigncolor $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   913
    set currentparents {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   914
    set dupparents {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   915
    if {[info exists commitlisted($id)] && [info exists parents($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   916
	foreach p $parents($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   917
	    if {[lsearch -exact $currentparents $p] < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   918
		lappend currentparents $p
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   919
	    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   920
		# remember that this parent was listed twice
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   921
		lappend dupparents $p
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   922
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   923
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   924
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   925
    set x [xcoord $level $level $lineno]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   926
    set y1 $canvy
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   927
    set canvy [expr $canvy + $linespc]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   928
    allcanvs conf -scrollregion \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   929
	[list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   930
    if {[info exists mainline($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   931
	lappend mainline($id) $x $y1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   932
	if {$mainlinearrow($id) ne "none"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   933
	    set mainline($id) [trimdiagstart $mainline($id)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   934
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   935
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   936
    drawlines $id 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   937
    set orad [expr {$linespc / 3}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   938
    set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   939
	       [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   940
	       -fill $ofill -outline black -width 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   941
    $canv raise $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   942
    $canv bind $t <1> {selcanvline {} %x %y}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   943
    set xt [xcoord [llength $displist] $level $lineno]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   944
    if {[llength $currentparents] > 2} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   945
	set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   946
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   947
    set rowtextx($lineno) $xt
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   948
    set idpos($id) [list $x $xt $y1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   949
    if {[info exists idtags($id)] || [info exists idheads($id)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   950
	|| [info exists idotherrefs($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   951
	set xt [drawtags $id $x $xt $y1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   952
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   953
    set headline [lindex $commitinfo($id) 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   954
    set name [lindex $commitinfo($id) 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   955
    set date [lindex $commitinfo($id) 2]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   956
    set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   957
			       -text $headline -font $mainfont ]
5392
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
   958
    $canv bind $linehtag($lineno) <<B3>> "rowmenu %X %Y $id"
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   959
    set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   960
			       -text $name -font $namefont]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   961
    set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   962
			       -text $date -font $mainfont]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   963
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   964
    set olddlevel $level
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   965
    set olddisplist $displist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   966
    set oldnlines [llength $displist]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   967
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   968
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   969
proc drawtags {id x xt y1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   970
    global idtags idheads idotherrefs
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   971
    global linespc lthickness
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   972
    global canv mainfont idline rowtextx
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   973
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   974
    set marks {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   975
    set ntags 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   976
    set nheads 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   977
    if {[info exists idtags($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   978
	set marks $idtags($id)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   979
	set ntags [llength $marks]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   980
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   981
    if {[info exists idheads($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   982
	set marks [concat $marks $idheads($id)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   983
	set nheads [llength $idheads($id)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   984
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   985
    if {[info exists idotherrefs($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   986
	set marks [concat $marks $idotherrefs($id)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   987
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   988
    if {$marks eq {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   989
	return $xt
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   990
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   991
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   992
    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   993
    set yt [expr $y1 - 0.5 * $linespc]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   994
    set yb [expr $yt + $linespc - 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   995
    set xvals {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   996
    set wvals {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   997
    foreach tag $marks {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   998
	set wid [font measure $mainfont $tag]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   999
	lappend xvals $xt
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1000
	lappend wvals $wid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1001
	set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1002
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1003
    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1004
	       -width $lthickness -fill black -tags tag.$id]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1005
    $canv lower $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1006
    foreach tag $marks x $xvals wid $wvals {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1007
	set xl [expr $x + $delta]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1008
	set xr [expr $x + $delta + $wid + $lthickness]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1009
	if {[incr ntags -1] >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1010
	    # draw a tag
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1011
	    set t [$canv create polygon $x [expr $yt + $delta] $xl $yt \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1012
		       $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1013
		       -width 1 -outline black -fill yellow -tags tag.$id]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1014
	    $canv bind $t <1> [list showtag $tag 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1015
	    set rowtextx($idline($id)) [expr {$xr + $linespc}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1016
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1017
	    # draw a head or other ref
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1018
	    if {[incr nheads -1] >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1019
		set col green
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1020
	    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1021
		set col "#ddddff"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1022
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1023
	    set xl [expr $xl - $delta/2]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1024
	    $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1025
		-width 1 -outline black -fill $col -tags tag.$id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1026
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1027
	set t [$canv create text $xl $y1 -anchor w -text $tag \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1028
		   -font $mainfont -tags tag.$id]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1029
	if {$ntags >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1030
	    $canv bind $t <1> [list showtag $tag 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1031
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1032
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1033
    return $xt
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1034
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1035
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1036
proc notecrossings {id lo hi corner} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1037
    global olddisplist crossings cornercrossings
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1038
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1039
    for {set i $lo} {[incr i] < $hi} {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1040
	set p [lindex $olddisplist $i]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1041
	if {$p == {}} continue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1042
	if {$i == $corner} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1043
	    if {![info exists cornercrossings($id)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1044
		|| [lsearch -exact $cornercrossings($id) $p] < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1045
		lappend cornercrossings($id) $p
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1046
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1047
	    if {![info exists cornercrossings($p)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1048
		|| [lsearch -exact $cornercrossings($p) $id] < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1049
		lappend cornercrossings($p) $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1050
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1051
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1052
	    if {![info exists crossings($id)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1053
		|| [lsearch -exact $crossings($id) $p] < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1054
		lappend crossings($id) $p
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1055
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1056
	    if {![info exists crossings($p)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1057
		|| [lsearch -exact $crossings($p) $id] < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1058
		lappend crossings($p) $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1059
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1060
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1061
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1062
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1063
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1064
proc xcoord {i level ln} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1065
    global canvx0 xspc1 xspc2
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1066
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1067
    set x [expr {$canvx0 + $i * $xspc1($ln)}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1068
    if {$i > 0 && $i == $level} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1069
	set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1070
    } elseif {$i > $level} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1071
	set x [expr {$x + $xspc2 - $xspc1($ln)}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1072
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1073
    return $x
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1074
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1075
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1076
# it seems Tk can't draw arrows on the end of diagonal line segments...
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1077
proc trimdiagend {line} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1078
    while {[llength $line] > 4} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1079
	set x1 [lindex $line end-3]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1080
	set y1 [lindex $line end-2]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1081
	set x2 [lindex $line end-1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1082
	set y2 [lindex $line end]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1083
	if {($x1 == $x2) != ($y1 == $y2)} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1084
	set line [lreplace $line end-1 end]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1085
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1086
    return $line
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1087
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1088
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1089
proc trimdiagstart {line} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1090
    while {[llength $line] > 4} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1091
	set x1 [lindex $line 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1092
	set y1 [lindex $line 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1093
	set x2 [lindex $line 2]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1094
	set y2 [lindex $line 3]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1095
	if {($x1 == $x2) != ($y1 == $y2)} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1096
	set line [lreplace $line 0 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1097
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1098
    return $line
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1099
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1100
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1101
proc drawslants {id needonscreen nohs} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1102
    global canv mainline mainlinearrow sidelines
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1103
    global canvx0 canvy xspc1 xspc2 lthickness
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1104
    global currentparents dupparents
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1105
    global lthickness linespc canvy colormap lineno geometry
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1106
    global maxgraphpct maxwidth
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1107
    global displist onscreen lastuse
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1108
    global parents commitlisted
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1109
    global oldnlines olddlevel olddisplist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1110
    global nhyperspace numcommits nnewparents
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1111
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1112
    if {$lineno < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1113
	lappend displist $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1114
	set onscreen($id) 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1115
	return 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1116
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1117
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1118
    set y1 [expr {$canvy - $linespc}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1119
    set y2 $canvy
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1120
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1121
    # work out what we need to get back on screen
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1122
    set reins {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1123
    if {$onscreen($id) < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1124
	# next to do isn't displayed, better get it on screen...
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1125
	lappend reins [list $id 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1126
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1127
    # make sure all the previous commits's parents are on the screen
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1128
    foreach p $currentparents {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1129
	if {$onscreen($p) < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1130
	    lappend reins [list $p 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1131
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1132
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1133
    # bring back anything requested by caller
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1134
    if {$needonscreen ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1135
	lappend reins $needonscreen
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1136
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1137
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1138
    # try the shortcut
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1139
    if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1140
	set dlevel $olddlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1141
	set x [xcoord $dlevel $dlevel $lineno]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1142
	set mainline($id) [list $x $y1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1143
	set mainlinearrow($id) none
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1144
	set lastuse($id) $lineno
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1145
	set displist [lreplace $displist $dlevel $dlevel $id]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1146
	set onscreen($id) 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1147
	set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1148
	return $dlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1149
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1150
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1151
    # update displist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1152
    set displist [lreplace $displist $olddlevel $olddlevel]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1153
    set j $olddlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1154
    foreach p $currentparents {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1155
	set lastuse($p) $lineno
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1156
	if {$onscreen($p) == 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1157
	    set displist [linsert $displist $j $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1158
	    set onscreen($p) 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1159
	    incr j
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1160
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1161
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1162
    if {$onscreen($id) == 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1163
	lappend displist $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1164
	set onscreen($id) 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1165
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1166
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1167
    # remove the null entry if present
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1168
    set nullentry [lsearch -exact $displist {}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1169
    if {$nullentry >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1170
	set displist [lreplace $displist $nullentry $nullentry]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1171
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1172
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1173
    # bring back the ones we need now (if we did it earlier
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1174
    # it would change displist and invalidate olddlevel)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1175
    foreach pi $reins {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1176
	# test again in case of duplicates in reins
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1177
	set p [lindex $pi 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1178
	if {$onscreen($p) < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1179
	    set onscreen($p) 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1180
	    set lastuse($p) $lineno
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1181
	    set displist [linsert $displist [lindex $pi 1] $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1182
	    incr nhyperspace -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1183
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1184
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1185
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1186
    set lastuse($id) $lineno
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1187
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1188
    # see if we need to make any lines jump off into hyperspace
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1189
    set displ [llength $displist]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1190
    if {$displ > $maxwidth} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1191
	set ages {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1192
	foreach x $displist {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1193
	    lappend ages [list $lastuse($x) $x]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1194
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1195
	set ages [lsort -integer -index 0 $ages]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1196
	set k 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1197
	while {$displ > $maxwidth} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1198
	    set use [lindex $ages $k 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1199
	    set victim [lindex $ages $k 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1200
	    if {$use >= $lineno - 5} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1201
	    incr k
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1202
	    if {[lsearch -exact $nohs $victim] >= 0} continue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1203
	    set i [lsearch -exact $displist $victim]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1204
	    set displist [lreplace $displist $i $i]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1205
	    set onscreen($victim) -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1206
	    incr nhyperspace
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1207
	    incr displ -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1208
	    if {$i < $nullentry} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1209
		incr nullentry -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1210
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1211
	    set x [lindex $mainline($victim) end-1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1212
	    lappend mainline($victim) $x $y1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1213
	    set line [trimdiagend $mainline($victim)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1214
	    set arrow "last"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1215
	    if {$mainlinearrow($victim) ne "none"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1216
		set line [trimdiagstart $line]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1217
		set arrow "both"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1218
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1219
	    lappend sidelines($victim) [list $line 1 $arrow]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1220
	    unset mainline($victim)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1221
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1222
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1223
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1224
    set dlevel [lsearch -exact $displist $id]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1225
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1226
    # If we are reducing, put in a null entry
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1227
    if {$displ < $oldnlines} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1228
	# does the next line look like a merge?
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1229
	# i.e. does it have > 1 new parent?
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1230
	if {$nnewparents($id) > 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1231
	    set i [expr {$dlevel + 1}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1232
	} elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1233
	    set i $olddlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1234
	    if {$nullentry >= 0 && $nullentry < $i} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1235
		incr i -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1236
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1237
	} elseif {$nullentry >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1238
	    set i $nullentry
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1239
	    while {$i < $displ
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1240
		   && [lindex $olddisplist $i] == [lindex $displist $i]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1241
		incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1242
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1243
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1244
	    set i $olddlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1245
	    if {$dlevel >= $i} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1246
		incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1247
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1248
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1249
	if {$i < $displ} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1250
	    set displist [linsert $displist $i {}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1251
	    incr displ
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1252
	    if {$dlevel >= $i} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1253
		incr dlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1254
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1255
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1256
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1257
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1258
    # decide on the line spacing for the next line
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1259
    set lj [expr {$lineno + 1}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1260
    set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1261
    if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1262
	set xspc1($lj) $xspc2
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1263
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1264
	set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1265
	if {$xspc1($lj) < $lthickness} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1266
	    set xspc1($lj) $lthickness
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1267
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1268
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1269
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1270
    foreach idi $reins {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1271
	set id [lindex $idi 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1272
	set j [lsearch -exact $displist $id]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1273
	set xj [xcoord $j $dlevel $lj]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1274
	set mainline($id) [list $xj $y2]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1275
	set mainlinearrow($id) first
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1276
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1277
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1278
    set i -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1279
    foreach id $olddisplist {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1280
	incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1281
	if {$id == {}} continue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1282
	if {$onscreen($id) <= 0} continue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1283
	set xi [xcoord $i $olddlevel $lineno]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1284
	if {$i == $olddlevel} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1285
	    foreach p $currentparents {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1286
		set j [lsearch -exact $displist $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1287
		set coords [list $xi $y1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1288
		set xj [xcoord $j $dlevel $lj]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1289
		if {$xj < $xi - $linespc} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1290
		    lappend coords [expr {$xj + $linespc}] $y1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1291
		    notecrossings $p $j $i [expr {$j + 1}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1292
		} elseif {$xj > $xi + $linespc} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1293
		    lappend coords [expr {$xj - $linespc}] $y1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1294
		    notecrossings $p $i $j [expr {$j - 1}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1295
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1296
		if {[lsearch -exact $dupparents $p] >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1297
		    # draw a double-width line to indicate the doubled parent
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1298
		    lappend coords $xj $y2
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1299
		    lappend sidelines($p) [list $coords 2 none]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1300
		    if {![info exists mainline($p)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1301
			set mainline($p) [list $xj $y2]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1302
			set mainlinearrow($p) none
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1303
		    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1304
		} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1305
		    # normal case, no parent duplicated
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1306
		    set yb $y2
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1307
		    set dx [expr {abs($xi - $xj)}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1308
		    if {0 && $dx < $linespc} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1309
			set yb [expr {$y1 + $dx}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1310
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1311
		    if {![info exists mainline($p)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1312
			if {$xi != $xj} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1313
			    lappend coords $xj $yb
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1314
			}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1315
			set mainline($p) $coords
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1316
			set mainlinearrow($p) none
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1317
		    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1318
			lappend coords $xj $yb
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1319
			if {$yb < $y2} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1320
			    lappend coords $xj $y2
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1321
			}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1322
			lappend sidelines($p) [list $coords 1 none]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1323
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1324
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1325
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1326
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1327
	    set j $i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1328
	    if {[lindex $displist $i] != $id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1329
		set j [lsearch -exact $displist $id]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1330
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1331
	    if {$j != $i || $xspc1($lineno) != $xspc1($lj)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1332
		|| ($olddlevel < $i && $i < $dlevel)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1333
		|| ($dlevel < $i && $i < $olddlevel)} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1334
		set xj [xcoord $j $dlevel $lj]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1335
		lappend mainline($id) $xi $y1 $xj $y2
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1336
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1337
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1338
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1339
    return $dlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1340
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1341
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1342
# search for x in a list of lists
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1343
proc llsearch {llist x} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1344
    set i 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1345
    foreach l $llist {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1346
	if {$l == $x || [lsearch -exact $l $x] >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1347
	    return $i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1348
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1349
	incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1350
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1351
    return -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1352
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1353
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1354
proc drawmore {reading} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1355
    global displayorder numcommits ncmupdate nextupdate
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1356
    global stopped nhyperspace parents commitlisted
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1357
    global maxwidth onscreen displist currentparents olddlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1358
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1359
    set n [llength $displayorder]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1360
    while {$numcommits < $n} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1361
	set id [lindex $displayorder $numcommits]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1362
	set ctxend [expr {$numcommits + 10}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1363
	if {!$reading && $ctxend > $n} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1364
	    set ctxend $n
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1365
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1366
	set dlist {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1367
	if {$numcommits > 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1368
	    set dlist [lreplace $displist $olddlevel $olddlevel]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1369
	    set i $olddlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1370
	    foreach p $currentparents {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1371
		if {$onscreen($p) == 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1372
		    set dlist [linsert $dlist $i $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1373
		    incr i
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1374
		}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1375
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1376
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1377
	set nohs {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1378
	set reins {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1379
	set isfat [expr {[llength $dlist] > $maxwidth}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1380
	if {$nhyperspace > 0 || $isfat} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1381
	    if {$ctxend > $n} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1382
	    # work out what to bring back and
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1383
	    # what we want to don't want to send into hyperspace
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1384
	    set room 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1385
	    for {set k $numcommits} {$k < $ctxend} {incr k} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1386
		set x [lindex $displayorder $k]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1387
		set i [llsearch $dlist $x]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1388
		if {$i < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1389
		    set i [llength $dlist]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1390
		    lappend dlist $x
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1391
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1392
		if {[lsearch -exact $nohs $x] < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1393
		    lappend nohs $x
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1394
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1395
		if {$reins eq {} && $onscreen($x) < 0 && $room} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1396
		    set reins [list $x $i]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1397
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1398
		set newp {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1399
		if {[info exists commitlisted($x)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1400
		    set right 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1401
		    foreach p $parents($x) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1402
			if {[llsearch $dlist $p] < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1403
			    lappend newp $p
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1404
			    if {[lsearch -exact $nohs $p] < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1405
				lappend nohs $p
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1406
			    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1407
			    if {$reins eq {} && $onscreen($p) < 0 && $room} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1408
				set reins [list $p [expr {$i + $right}]]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1409
			    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1410
			}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1411
			set right 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1412
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1413
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1414
		set l [lindex $dlist $i]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1415
		if {[llength $l] == 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1416
		    set l $newp
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1417
		} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1418
		    set j [lsearch -exact $l $x]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1419
		    set l [concat [lreplace $l $j $j] $newp]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1420
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1421
		set dlist [lreplace $dlist $i $i $l]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1422
		if {$room && $isfat && [llength $newp] <= 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1423
		    set room 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1424
		}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1425
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1426
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1427
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1428
	set dlevel [drawslants $id $reins $nohs]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1429
	drawcommitline $dlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1430
	if {[clock clicks -milliseconds] >= $nextupdate
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1431
	    && $numcommits >= $ncmupdate} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1432
	    doupdate $reading
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1433
	    if {$stopped} break
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1434
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1435
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1436
}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1437
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1438
# level here is an index in todo
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1439
proc updatetodo {level noshortcut} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1440
    global ncleft todo nnewparents
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1441
    global commitlisted parents onscreen
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1442
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1443
    set id [lindex $todo $level]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1444
    set olds {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1445
    if {[info exists commitlisted($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1446
	foreach p $parents($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1447
	    if {[lsearch -exact $olds $p] < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1448
		lappend olds $p
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1449
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1450
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1451
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1452
    if {!$noshortcut && [llength $olds] == 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1453
	set p [lindex $olds 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1454
	if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1455
	    set ncleft($p) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1456
	    set todo [lreplace $todo $level $level $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1457
	    set onscreen($p) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1458
	    set nnewparents($id) 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1459
	    return 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1460
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1461
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1462
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1463
    set todo [lreplace $todo $level $level]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1464
    set i $level
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1465
    set n 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1466
    foreach p $olds {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1467
	incr ncleft($p) -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1468
	set k [lsearch -exact $todo $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1469
	if {$k < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1470
	    set todo [linsert $todo $i $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1471
	    set onscreen($p) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1472
	    incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1473
	    incr n
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1474
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1475
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1476
    set nnewparents($id) $n
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1477
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1478
    return 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1479
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1480
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1481
proc decidenext {{noread 0}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1482
    global ncleft todo
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1483
    global datemode cdate
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1484
    global commitinfo
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1485
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1486
    # choose which one to do next time around
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1487
    set todol [llength $todo]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1488
    set level -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1489
    set latest {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1490
    for {set k $todol} {[incr k -1] >= 0} {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1491
	set p [lindex $todo $k]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1492
	if {$ncleft($p) == 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1493
	    if {$datemode} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1494
		if {![info exists commitinfo($p)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1495
		    if {$noread} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1496
			return {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1497
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1498
		    readcommit $p
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1499
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1500
		if {$latest == {} || $cdate($p) > $latest} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1501
		    set level $k
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1502
		    set latest $cdate($p)
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1503
		}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1504
	    } else {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1505
		set level $k
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1506
		break
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1507
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1508
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1509
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1510
    if {$level < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1511
	if {$todo != {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1512
	    puts "ERROR: none of the pending commits can be done yet:"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1513
	    foreach p $todo {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1514
		puts "  $p ($ncleft($p))"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1515
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1516
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1517
	return -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1518
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1519
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1520
    return $level
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1521
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1522
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1523
proc drawcommit {id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1524
    global phase todo nchildren datemode nextupdate
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1525
    global numcommits ncmupdate displayorder todo onscreen
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1526
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1527
    if {$phase != "incrdraw"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1528
	set phase incrdraw
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1529
	set displayorder {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1530
	set todo {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1531
	initgraph
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1532
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1533
    if {$nchildren($id) == 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1534
	lappend todo $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1535
	set onscreen($id) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1536
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1537
    set level [decidenext 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1538
    if {$level == {} || $id != [lindex $todo $level]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1539
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1540
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1541
    while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1542
	lappend displayorder [lindex $todo $level]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1543
	if {[updatetodo $level $datemode]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1544
	    set level [decidenext 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1545
	    if {$level == {}} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1546
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1547
	set id [lindex $todo $level]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1548
	if {![info exists commitlisted($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1549
	    break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1550
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1551
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1552
    drawmore 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1553
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1554
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1555
proc finishcommits {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1556
    global phase
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1557
    global canv mainfont ctext maincursor textcursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1558
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1559
    if {$phase != "incrdraw"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1560
	$canv delete all
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1561
	$canv create text 3 3 -anchor nw -text "No commits selected" \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1562
	    -font $mainfont -tags textitems
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1563
	set phase {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1564
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1565
	drawrest
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1566
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1567
    . config -cursor $maincursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1568
    settextcursor $textcursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1569
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1570
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1571
# Don't change the text pane cursor if it is currently the hand cursor,
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1572
# showing that we are over a sha1 ID link.
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1573
proc settextcursor {c} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1574
    global ctext curtextcursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1575
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1576
    if {[$ctext cget -cursor] == $curtextcursor} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1577
	$ctext config -cursor $c
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1578
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1579
    set curtextcursor $c
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1580
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1581
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1582
proc drawgraph {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1583
    global nextupdate startmsecs ncmupdate
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1584
    global displayorder onscreen
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1585
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1586
    if {$displayorder == {}} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1587
    set startmsecs [clock clicks -milliseconds]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1588
    set nextupdate [expr $startmsecs + 100]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1589
    set ncmupdate 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1590
    initgraph
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1591
    foreach id $displayorder {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1592
	set onscreen($id) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1593
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1594
    drawmore 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1595
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1596
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1597
proc drawrest {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1598
    global phase stopped redisplaying selectedline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1599
    global datemode todo displayorder
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1600
    global numcommits ncmupdate
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1601
    global nextupdate startmsecs
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1602
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1603
    set level [decidenext]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1604
    if {$level >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1605
	set phase drawgraph
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1606
	while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1607
	    lappend displayorder [lindex $todo $level]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1608
	    set hard [updatetodo $level $datemode]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1609
	    if {$hard} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1610
		set level [decidenext]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1611
		if {$level < 0} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1612
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1613
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1614
	drawmore 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1615
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1616
    set phase {}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1617
    set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1618
    #puts "overall $drawmsecs ms for $numcommits commits"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1619
    if {$redisplaying} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1620
	if {$stopped == 0 && [info exists selectedline]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1621
	    selectline $selectedline 0
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1622
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1623
	if {$stopped == 1} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1624
	    set stopped 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1625
	    after idle drawgraph
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1626
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1627
	    set redisplaying 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1628
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1629
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1630
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1631
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1632
proc findmatches {f} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1633
    global findtype foundstring foundstrlen
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1634
    if {$findtype == "Regexp"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1635
	set matches [regexp -indices -all -inline $foundstring $f]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1636
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1637
	if {$findtype == "IgnCase"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1638
	    set str [string tolower $f]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1639
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1640
	    set str $f
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1641
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1642
	set matches {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1643
	set i 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1644
	while {[set j [string first $foundstring $str $i]] >= 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1645
	    lappend matches [list $j [expr $j+$foundstrlen-1]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1646
	    set i [expr $j + $foundstrlen]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1647
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1648
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1649
    return $matches
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1650
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1651
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1652
proc dofind {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1653
    global findtype findloc findstring markedmatches commitinfo
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1654
    global numcommits lineid linehtag linentag linedtag
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1655
    global mainfont namefont canv canv2 canv3 selectedline
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1656
    global matchinglines foundstring foundstrlen
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1657
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1658
    stopfindproc
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1659
    unmarkmatches
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1660
    focus .
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1661
    set matchinglines {}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1662
    if {$findloc == "Pickaxe"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1663
	findpatches
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1664
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1665
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1666
    if {$findtype == "IgnCase"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1667
	set foundstring [string tolower $findstring]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1668
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1669
	set foundstring $findstring
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1670
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1671
    set foundstrlen [string length $findstring]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1672
    if {$foundstrlen == 0} return
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1673
    if {$findloc == "Files"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1674
	findfiles
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1675
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1676
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1677
    if {![info exists selectedline]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1678
	set oldsel -1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1679
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1680
	set oldsel $selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1681
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1682
    set didsel 0
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1683
    set fldtypes {Headline Author Date Committer CDate Comment}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1684
    for {set l 0} {$l < $numcommits} {incr l} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1685
	set id $lineid($l)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1686
	set info $commitinfo($id)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1687
	set doesmatch 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1688
	foreach f $info ty $fldtypes {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1689
	    if {$findloc != "All fields" && $findloc != $ty} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1690
		continue
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1691
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1692
	    set matches [findmatches $f]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1693
	    if {$matches == {}} continue
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1694
	    set doesmatch 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1695
	    if {$ty == "Headline"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1696
		markmatches $canv $l $f $linehtag($l) $matches $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1697
	    } elseif {$ty == "Author"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1698
		markmatches $canv2 $l $f $linentag($l) $matches $namefont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1699
	    } elseif {$ty == "Date"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1700
		markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1701
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1702
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1703
	if {$doesmatch} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1704
	    lappend matchinglines $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1705
	    if {!$didsel && $l > $oldsel} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1706
		findselectline $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1707
		set didsel 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1708
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1709
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1710
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1711
    if {$matchinglines == {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1712
	bell
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1713
    } elseif {!$didsel} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1714
	findselectline [lindex $matchinglines 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1715
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1716
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1717
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1718
proc findselectline {l} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1719
    global findloc commentend ctext
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1720
    selectline $l 1
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1721
    if {$findloc == "All fields" || $findloc == "Comments"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1722
	# highlight the matches in the comments
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1723
	set f [$ctext get 1.0 $commentend]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1724
	set matches [findmatches $f]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1725
	foreach match $matches {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1726
	    set start [lindex $match 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1727
	    set end [expr [lindex $match 1] + 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1728
	    $ctext tag add found "1.0 + $start c" "1.0 + $end c"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1729
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1730
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1731
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1732
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1733
proc findnext {restart} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1734
    global matchinglines selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1735
    if {![info exists matchinglines]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1736
	if {$restart} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1737
	    dofind
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1738
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1739
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1740
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1741
    if {![info exists selectedline]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1742
    foreach l $matchinglines {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1743
	if {$l > $selectedline} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1744
	    findselectline $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1745
	    return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1746
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1747
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1748
    bell
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1749
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1750
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1751
proc findprev {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1752
    global matchinglines selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1753
    if {![info exists matchinglines]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1754
	dofind
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1755
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1756
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1757
    if {![info exists selectedline]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1758
    set prev {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1759
    foreach l $matchinglines {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1760
	if {$l >= $selectedline} break
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1761
	set prev $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1762
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1763
    if {$prev != {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1764
	findselectline $prev
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1765
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1766
	bell
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1767
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1768
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1769
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1770
proc findlocchange {name ix op} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1771
    global findloc findtype findtypemenu
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1772
    if {$findloc == "Pickaxe"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1773
	set findtype Exact
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1774
	set state disabled
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1775
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1776
	set state normal
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1777
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1778
    $findtypemenu entryconf 1 -state $state
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1779
    $findtypemenu entryconf 2 -state $state
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1780
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1781
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1782
proc stopfindproc {{done 0}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1783
    global findprocpid findprocfile findids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1784
    global ctext findoldcursor phase maincursor textcursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1785
    global findinprogress
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1786
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1787
    catch {unset findids}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1788
    if {[info exists findprocpid]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1789
	if {!$done} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1790
	    catch {exec kill $findprocpid}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1791
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1792
	catch {close $findprocfile}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1793
	unset findprocpid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1794
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1795
    if {[info exists findinprogress]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1796
	unset findinprogress
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1797
	if {$phase != "incrdraw"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1798
	    . config -cursor $maincursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1799
	    settextcursor $textcursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1800
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1801
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1802
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1803
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1804
proc findpatches {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1805
    global findstring selectedline numcommits
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1806
    global findprocpid findprocfile
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1807
    global finddidsel ctext lineid findinprogress
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1808
    global findinsertpos
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
  1809
    global env
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1810
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1811
    if {$numcommits == 0} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1812
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1813
    # make a list of all the ids to search, starting at the one
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1814
    # after the selected line (if any)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1815
    if {[info exists selectedline]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1816
	set l $selectedline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1817
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1818
	set l -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1819
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1820
    set inputids {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1821
    for {set i 0} {$i < $numcommits} {incr i} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1822
	if {[incr l] >= $numcommits} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1823
	    set l 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1824
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1825
	append inputids $lineid($l) "\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1826
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1827
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1828
    if {[catch {
4740
e1d1b22bab57 Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4688
diff changeset
  1829
	set f [open [list | $env(HG) --config ui.report_untrusted=false debug-diff-tree --stdin -s -r -S$findstring << $inputids] r]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1830
    } err]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1831
	error_popup "Error starting search process: $err"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1832
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1833
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1834
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1835
    set findinsertpos end
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1836
    set findprocfile $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1837
    set findprocpid [pid $f]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1838
    fconfigure $f -blocking 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1839
    fileevent $f readable readfindproc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1840
    set finddidsel 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1841
    . config -cursor watch
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1842
    settextcursor watch
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1843
    set findinprogress 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1844
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1845
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1846
proc readfindproc {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1847
    global findprocfile finddidsel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1848
    global idline matchinglines findinsertpos
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1849
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1850
    set n [gets $findprocfile line]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1851
    if {$n < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1852
	if {[eof $findprocfile]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1853
	    stopfindproc 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1854
	    if {!$finddidsel} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1855
		bell
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1856
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1857
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1858
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1859
    }
3059
3dab573a4330 hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents: 2297
diff changeset
  1860
    if {![regexp {^[0-9a-f]{12}} $line id]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1861
	error_popup "Can't parse git-diff-tree output: $line"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1862
	stopfindproc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1863
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1864
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1865
    if {![info exists idline($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1866
	puts stderr "spurious id: $id"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1867
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1868
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1869
    set l $idline($id)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1870
    insertmatch $l $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1871
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1872
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1873
proc insertmatch {l id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1874
    global matchinglines findinsertpos finddidsel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1875
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1876
    if {$findinsertpos == "end"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1877
	if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1878
	    set matchinglines [linsert $matchinglines 0 $l]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1879
	    set findinsertpos 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1880
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1881
	    lappend matchinglines $l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1882
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1883
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1884
	set matchinglines [linsert $matchinglines $findinsertpos $l]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1885
	incr findinsertpos
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1886
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1887
    markheadline $l $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1888
    if {!$finddidsel} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1889
	findselectline $l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1890
	set finddidsel 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1891
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1892
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1893
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1894
proc findfiles {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1895
    global selectedline numcommits lineid ctext
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1896
    global ffileline finddidsel parents nparents
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1897
    global findinprogress findstartline findinsertpos
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1898
    global treediffs fdiffids fdiffsneeded fdiffpos
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1899
    global findmergefiles
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
  1900
    global env
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1901
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1902
    if {$numcommits == 0} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1903
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1904
    if {[info exists selectedline]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1905
	set l [expr {$selectedline + 1}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1906
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1907
	set l 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1908
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1909
    set ffileline $l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1910
    set findstartline $l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1911
    set diffsneeded {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1912
    set fdiffsneeded {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1913
    while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1914
	set id $lineid($l)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1915
	if {$findmergefiles || $nparents($id) == 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1916
	    foreach p $parents($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1917
		if {![info exists treediffs([list $id $p])]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1918
		    append diffsneeded "$id $p\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1919
		    lappend fdiffsneeded [list $id $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1920
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1921
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1922
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1923
	if {[incr l] >= $numcommits} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1924
	    set l 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1925
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1926
	if {$l == $findstartline} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1927
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1928
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1929
    # start off a git-diff-tree process if needed
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1930
    if {$diffsneeded ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1931
	if {[catch {
4740
e1d1b22bab57 Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4688
diff changeset
  1932
	    set df [open [list | $env(HG) --config ui.report_untrusted=false debug-diff-tree -r --stdin << $diffsneeded] r]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1933
	} err ]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1934
	    error_popup "Error starting search process: $err"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1935
	    return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1936
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1937
	catch {unset fdiffids}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1938
	set fdiffpos 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1939
	fconfigure $df -blocking 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1940
	fileevent $df readable [list readfilediffs $df]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1941
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1942
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1943
    set finddidsel 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1944
    set findinsertpos end
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1945
    set id $lineid($l)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1946
    set p [lindex $parents($id) 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1947
    . config -cursor watch
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1948
    settextcursor watch
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1949
    set findinprogress 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1950
    findcont [list $id $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1951
    update
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1952
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1953
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1954
proc readfilediffs {df} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1955
    global findids fdiffids fdiffs
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1956
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1957
    set n [gets $df line]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1958
    if {$n < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1959
	if {[eof $df]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1960
	    donefilediff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1961
	    if {[catch {close $df} err]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1962
		stopfindproc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1963
		bell
1278
6a0d373d3126 hgit -> hgk.py
mpm@selenic.com
parents: 1240
diff changeset
  1964
		error_popup "Error in hg debug-diff-tree: $err"
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1965
	    } elseif {[info exists findids]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1966
		set ids $findids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1967
		stopfindproc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1968
		bell
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1969
		error_popup "Couldn't find diffs for {$ids}"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1970
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1971
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1972
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1973
    }
3059
3dab573a4330 hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents: 2297
diff changeset
  1974
    if {[regexp {^([0-9a-f]{12}) \(from ([0-9a-f]{12})\)} $line match id p]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1975
	# start of a new string of diffs
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1976
	donefilediff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1977
	set fdiffids [list $id $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1978
	set fdiffs {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1979
    } elseif {[string match ":*" $line]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1980
	lappend fdiffs [lindex $line 5]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1981
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1982
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1983
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1984
proc donefilediff {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1985
    global fdiffids fdiffs treediffs findids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1986
    global fdiffsneeded fdiffpos
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1987
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1988
    if {[info exists fdiffids]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1989
	while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1990
	       && $fdiffpos < [llength $fdiffsneeded]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1991
	    # git-diff-tree doesn't output anything for a commit
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1992
	    # which doesn't change anything
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1993
	    set nullids [lindex $fdiffsneeded $fdiffpos]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1994
	    set treediffs($nullids) {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1995
	    if {[info exists findids] && $nullids eq $findids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1996
		unset findids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1997
		findcont $nullids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1998
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1999
	    incr fdiffpos
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2000
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2001
	incr fdiffpos
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2002
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2003
	if {![info exists treediffs($fdiffids)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2004
	    set treediffs($fdiffids) $fdiffs
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2005
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2006
	if {[info exists findids] && $fdiffids eq $findids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2007
	    unset findids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2008
	    findcont $fdiffids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2009
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2010
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2011
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2012
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2013
proc findcont {ids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2014
    global findids treediffs parents nparents
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2015
    global ffileline findstartline finddidsel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2016
    global lineid numcommits matchinglines findinprogress
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2017
    global findmergefiles
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2018
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2019
    set id [lindex $ids 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2020
    set p [lindex $ids 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2021
    set pi [lsearch -exact $parents($id) $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2022
    set l $ffileline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2023
    while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2024
	if {$findmergefiles || $nparents($id) == 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2025
	    if {![info exists treediffs($ids)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2026
		set findids $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2027
		set ffileline $l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2028
		return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2029
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2030
	    set doesmatch 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2031
	    foreach f $treediffs($ids) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2032
		set x [findmatches $f]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2033
		if {$x != {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2034
		    set doesmatch 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2035
		    break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2036
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2037
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2038
	    if {$doesmatch} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2039
		insertmatch $l $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2040
		set pi $nparents($id)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2041
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2042
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2043
	    set pi $nparents($id)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2044
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2045
	if {[incr pi] >= $nparents($id)} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2046
	    set pi 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2047
	    if {[incr l] >= $numcommits} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2048
		set l 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2049
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2050
	    if {$l == $findstartline} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2051
	    set id $lineid($l)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2052
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2053
	set p [lindex $parents($id) $pi]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2054
	set ids [list $id $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2055
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2056
    stopfindproc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2057
    if {!$finddidsel} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2058
	bell
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2059
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2060
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2061
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2062
# mark a commit as matching by putting a yellow background
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2063
# behind the headline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2064
proc markheadline {l id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2065
    global canv mainfont linehtag commitinfo
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2066
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2067
    set bbox [$canv bbox $linehtag($l)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2068
    set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2069
    $canv lower $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2070
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2071
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2072
# mark the bits of a headline, author or date that match a find string
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2073
proc markmatches {canv l str tag matches font} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2074
    set bbox [$canv bbox $tag]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2075
    set x0 [lindex $bbox 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2076
    set y0 [lindex $bbox 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2077
    set y1 [lindex $bbox 3]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2078
    foreach match $matches {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2079
	set start [lindex $match 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2080
	set end [lindex $match 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2081
	if {$start > $end} continue
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2082
	set xoff [font measure $font [string range $str 0 [expr $start-1]]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2083
	set xlen [font measure $font [string range $str 0 [expr $end]]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2084
	set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2085
		   -outline {} -tags matches -fill yellow]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2086
	$canv lower $t
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2087
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2088
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2089
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2090
proc unmarkmatches {} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2091
    global matchinglines findids
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2092
    allcanvs delete matches
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2093
    catch {unset matchinglines}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2094
    catch {unset findids}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2095
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2096
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2097
proc selcanvline {w x y} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2098
    global canv canvy0 ctext linespc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2099
    global lineid linehtag linentag linedtag rowtextx
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2100
    set ymax [lindex [$canv cget -scrollregion] 3]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2101
    if {$ymax == {}} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2102
    set yfrac [lindex [$canv yview] 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2103
    set y [expr {$y + $yfrac * $ymax}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2104
    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2105
    if {$l < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2106
	set l 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2107
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2108
    if {$w eq $canv} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2109
	if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2110
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2111
    unmarkmatches
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2112
    selectline $l 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2113
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2114
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2115
proc commit_descriptor {p} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2116
    global commitinfo
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2117
    set l "..."
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2118
    if {[info exists commitinfo($p)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2119
	set l [lindex $commitinfo($p) 0]
3092
d0fcce3728d1 hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents: 3059
diff changeset
  2120
	set r [lindex $commitinfo($p) 6]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2121
    }
3092
d0fcce3728d1 hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents: 3059
diff changeset
  2122
    return "$r:$p ($l)"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2123
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2124
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2125
# append some text to the ctext widget, and make any SHA1 ID
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2126
# that we know about be a clickable link.
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2127
proc appendwithlinks {text} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2128
    global ctext idline linknum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2129
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2130
    set start [$ctext index "end - 1c"]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2131
    $ctext insert end $text
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2132
    $ctext insert end "\n"
3059
3dab573a4330 hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents: 2297
diff changeset
  2133
    set links [regexp -indices -all -inline {[0-9a-f]{12}} $text]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2134
    foreach l $links {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2135
	set s [lindex $l 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2136
	set e [lindex $l 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2137
	set linkid [string range $text $s $e]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2138
	if {![info exists idline($linkid)]} continue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2139
	incr e
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2140
	$ctext tag add link "$start + $s c" "$start + $e c"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2141
	$ctext tag add link$linknum "$start + $s c" "$start + $e c"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2142
	$ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2143
	incr linknum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2144
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2145
    $ctext tag conf link -foreground blue -underline 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2146
    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2147
    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2148
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2149
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2150
proc selectline {l isnew} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2151
    global canv canv2 canv3 ctext commitinfo selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2152
    global lineid linehtag linentag linedtag
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2153
    global canvy0 linespc parents nparents children
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2154
    global cflist currentid sha1entry
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2155
    global commentend idtags idline linknum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2156
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2157
    $canv delete hover
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2158
    normalline
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2159
    if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2160
    $canv delete secsel
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2161
    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2162
	       -tags secsel -fill [$canv cget -selectbackground]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2163
    $canv lower $t
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2164
    $canv2 delete secsel
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2165
    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2166
	       -tags secsel -fill [$canv2 cget -selectbackground]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2167
    $canv2 lower $t
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2168
    $canv3 delete secsel
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2169
    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2170
	       -tags secsel -fill [$canv3 cget -selectbackground]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2171
    $canv3 lower $t
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2172
    set y [expr {$canvy0 + $l * $linespc}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2173
    set ymax [lindex [$canv cget -scrollregion] 3]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2174
    set ytop [expr {$y - $linespc - 1}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2175
    set ybot [expr {$y + $linespc + 1}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2176
    set wnow [$canv yview]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2177
    set wtop [expr [lindex $wnow 0] * $ymax]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2178
    set wbot [expr [lindex $wnow 1] * $ymax]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2179
    set wh [expr {$wbot - $wtop}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2180
    set newtop $wtop
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2181
    if {$ytop < $wtop} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2182
	if {$ybot < $wtop} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2183
	    set newtop [expr {$y - $wh / 2.0}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2184
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2185
	    set newtop $ytop
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2186
	    if {$newtop > $wtop - $linespc} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2187
		set newtop [expr {$wtop - $linespc}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2188
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2189
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2190
    } elseif {$ybot > $wbot} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2191
	if {$ytop > $wbot} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2192
	    set newtop [expr {$y - $wh / 2.0}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2193
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2194
	    set newtop [expr {$ybot - $wh}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2195
	    if {$newtop < $wtop + $linespc} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2196
		set newtop [expr {$wtop + $linespc}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2197
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2198
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2199
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2200
    if {$newtop != $wtop} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2201
	if {$newtop < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2202
	    set newtop 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2203
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2204
	allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2205
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2206
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2207
    if {$isnew} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2208
	addtohistory [list selectline $l 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2209
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2210
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2211
    set selectedline $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2212
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2213
    set id $lineid($l)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2214
    set currentid $id
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2215
    $sha1entry delete 0 end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2216
    $sha1entry insert 0 $id
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2217
    $sha1entry selection from 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2218
    $sha1entry selection to end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2219
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2220
    $ctext conf -state normal
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2221
    $ctext delete 0.0 end
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2222
    set linknum 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2223
    $ctext mark set fmark.0 0.0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2224
    $ctext mark gravity fmark.0 left
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2225
    set info $commitinfo($id)
3092
d0fcce3728d1 hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents: 3059
diff changeset
  2226
    $ctext insert end "Revision: [lindex $info 6]\n"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2227
    $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2228
    $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2229
    if {[info exists idtags($id)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2230
	$ctext insert end "Tags:"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2231
	foreach tag $idtags($id) {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2232
	    $ctext insert end " $tag"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2233
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2234
	$ctext insert end "\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2235
    }
1308
2073e5a71008 Cleanup of tabs and trailing spaces.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 1278
diff changeset
  2236
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2237
    set comment {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2238
    if {[info exists parents($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2239
	foreach p $parents($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2240
	    append comment "Parent: [commit_descriptor $p]\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2241
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2242
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2243
    if {[info exists children($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2244
	foreach c $children($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2245
	    append comment "Child:  [commit_descriptor $c]\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2246
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2247
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2248
    append comment "\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2249
    append comment [lindex $info 5]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2250
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2251
    # make anything that looks like a SHA1 ID be a clickable link
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2252
    appendwithlinks $comment
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2253
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2254
    $ctext tag delete Comments
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2255
    $ctext tag remove found 1.0 end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2256
    $ctext conf -state disabled
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2257
    set commentend [$ctext index "end - 1c"]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2258
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2259
    $cflist delete 0 end
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2260
    $cflist insert end "Comments"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2261
    if {$nparents($id) == 1} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2262
	startdiff [concat $id $parents($id)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2263
    } elseif {$nparents($id) > 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2264
	mergediff $id
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2265
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2266
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2268
proc selnextline {dir} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2269
    global selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2270
    if {![info exists selectedline]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2271
    set l [expr $selectedline + $dir]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2272
    unmarkmatches
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2273
    selectline $l 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2274
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2275
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2276
proc unselectline {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2277
    global selectedline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2278
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2279
    catch {unset selectedline}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2280
    allcanvs delete secsel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2281
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2282
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2283
proc addtohistory {cmd} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2284
    global history historyindex
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2285
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2286
    if {$historyindex > 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2287
	&& [lindex $history [expr {$historyindex - 1}]] == $cmd} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2288
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2289
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2290
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2291
    if {$historyindex < [llength $history]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2292
	set history [lreplace $history $historyindex end $cmd]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2293
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2294
	lappend history $cmd
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2295
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2296
    incr historyindex
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2297
    if {$historyindex > 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2298
	.ctop.top.bar.leftbut conf -state normal
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2299
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2300
	.ctop.top.bar.leftbut conf -state disabled
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2301
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2302
    .ctop.top.bar.rightbut conf -state disabled
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2303
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2304
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2305
proc goback {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2306
    global history historyindex
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2307
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2308
    if {$historyindex > 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2309
	incr historyindex -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2310
	set cmd [lindex $history [expr {$historyindex - 1}]]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2311
	eval $cmd
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2312
	.ctop.top.bar.rightbut conf -state normal
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2313
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2314
    if {$historyindex <= 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2315
	.ctop.top.bar.leftbut conf -state disabled
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2316
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2317
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2318
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2319
proc goforw {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2320
    global history historyindex
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2321
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2322
    if {$historyindex < [llength $history]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2323
	set cmd [lindex $history $historyindex]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2324
	incr historyindex
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2325
	eval $cmd
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2326
	.ctop.top.bar.leftbut conf -state normal
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2327
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2328
    if {$historyindex >= [llength $history]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2329
	.ctop.top.bar.rightbut conf -state disabled
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2330
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2331
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2332
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2333
proc mergediff {id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2334
    global parents diffmergeid diffmergegca mergefilelist diffpindex
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2335
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2336
    set diffmergeid $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2337
    set diffpindex -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2338
    set diffmergegca [findgca $parents($id)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2339
    if {[info exists mergefilelist($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2340
	if {$mergefilelist($id) ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2341
	    showmergediff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2342
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2343
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2344
	contmergediff {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2345
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2346
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2347
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2348
proc findgca {ids} {
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
  2349
    global env
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2350
    set gca {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2351
    foreach id $ids {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2352
	if {$gca eq {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2353
	    set gca $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2354
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2355
	    if {[catch {
4740
e1d1b22bab57 Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4688
diff changeset
  2356
		set gca [exec $env(HG) --config ui.report_untrusted=false debug-merge-base $gca $id]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2357
	    } err]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2358
		return {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2359
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2360
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2361
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2362
    return $gca
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2363
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2364
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2365
proc contmergediff {ids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2366
    global diffmergeid diffpindex parents nparents diffmergegca
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2367
    global treediffs mergefilelist diffids treepending
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2368
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2369
    # diff the child against each of the parents, and diff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2370
    # each of the parents against the GCA.
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2371
    while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2372
	if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2373
	    set ids [list [lindex $ids 1] $diffmergegca]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2374
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2375
	    if {[incr diffpindex] >= $nparents($diffmergeid)} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2376
	    set p [lindex $parents($diffmergeid) $diffpindex]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2377
	    set ids [list $diffmergeid $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2378
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2379
	if {![info exists treediffs($ids)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2380
	    set diffids $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2381
	    if {![info exists treepending]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2382
		gettreediffs $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2383
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2384
	    return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2385
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2386
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2387
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2388
    # If a file in some parent is different from the child and also
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2389
    # different from the GCA, then it's interesting.
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2390
    # If we don't have a GCA, then a file is interesting if it is
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2391
    # different from the child in all the parents.
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2392
    if {$diffmergegca ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2393
	set files {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2394
	foreach p $parents($diffmergeid) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2395
	    set gcadiffs $treediffs([list $p $diffmergegca])
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2396
	    foreach f $treediffs([list $diffmergeid $p]) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2397
		if {[lsearch -exact $files $f] < 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2398
		    && [lsearch -exact $gcadiffs $f] >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2399
		    lappend files $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2400
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2401
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2402
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2403
	set files [lsort $files]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2404
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2405
	set p [lindex $parents($diffmergeid) 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2406
	set files $treediffs([list $diffmergeid $p])
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2407
	for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2408
	    set p [lindex $parents($diffmergeid) $i]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2409
	    set df $treediffs([list $diffmergeid $p])
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2410
	    set nf {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2411
	    foreach f $files {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2412
		if {[lsearch -exact $df $f] >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2413
		    lappend nf $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2414
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2415
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2416
	    set files $nf
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2417
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2418
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2419
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2420
    set mergefilelist($diffmergeid) $files
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2421
    if {$files ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2422
	showmergediff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2423
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2424
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2425
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2426
proc showmergediff {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2427
    global cflist diffmergeid mergefilelist parents
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2428
    global diffopts diffinhunk currentfile currenthunk filelines
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2429
    global diffblocked groupfilelast mergefds groupfilenum grouphunks
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
  2430
    global env
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2431
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2432
    set files $mergefilelist($diffmergeid)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2433
    foreach f $files {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2434
	$cflist insert end $f
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2435
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2436
    set env(GIT_DIFF_OPTS) $diffopts
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2437
    set flist {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2438
    catch {unset currentfile}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2439
    catch {unset currenthunk}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2440
    catch {unset filelines}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2441
    catch {unset groupfilenum}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2442
    catch {unset grouphunks}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2443
    set groupfilelast -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2444
    foreach p $parents($diffmergeid) {
4740
e1d1b22bab57 Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4688
diff changeset
  2445
	set cmd [list | $env(HG) --config ui.report_untrusted=false debug-diff-tree -p $p $diffmergeid]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2446
	set cmd [concat $cmd $mergefilelist($diffmergeid)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2447
	if {[catch {set f [open $cmd r]} err]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2448
	    error_popup "Error getting diffs: $err"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2449
	    foreach f $flist {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2450
		catch {close $f}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2451
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2452
	    return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2453
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2454
	lappend flist $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2455
	set ids [list $diffmergeid $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2456
	set mergefds($ids) $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2457
	set diffinhunk($ids) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2458
	set diffblocked($ids) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2459
	fconfigure $f -blocking 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2460
	fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2461
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2462
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2463
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2464
proc getmergediffline {f ids id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2465
    global diffmergeid diffinhunk diffoldlines diffnewlines
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2466
    global currentfile currenthunk
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2467
    global diffoldstart diffnewstart diffoldlno diffnewlno
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2468
    global diffblocked mergefilelist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2469
    global noldlines nnewlines difflcounts filelines
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2470
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2471
    set n [gets $f line]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2472
    if {$n < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2473
	if {![eof $f]} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2474
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2475
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2476
    if {!([info exists diffmergeid] && $diffmergeid == $id)} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2477
	if {$n < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2478
	    close $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2479
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2480
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2481
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2482
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2483
    if {$diffinhunk($ids) != 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2484
	set fi $currentfile($ids)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2485
	if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2486
	    # continuing an existing hunk
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2487
	    set line [string range $line 1 end]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2488
	    set p [lindex $ids 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2489
	    if {$match eq "-" || $match eq " "} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2490
		set filelines($p,$fi,$diffoldlno($ids)) $line
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2491
		incr diffoldlno($ids)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2492
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2493
	    if {$match eq "+" || $match eq " "} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2494
		set filelines($id,$fi,$diffnewlno($ids)) $line
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2495
		incr diffnewlno($ids)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2496
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2497
	    if {$match eq " "} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2498
		if {$diffinhunk($ids) == 2} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2499
		    lappend difflcounts($ids) \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2500
			[list $noldlines($ids) $nnewlines($ids)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2501
		    set noldlines($ids) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2502
		    set diffinhunk($ids) 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2503
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2504
		incr noldlines($ids)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2505
	    } elseif {$match eq "-" || $match eq "+"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2506
		if {$diffinhunk($ids) == 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2507
		    lappend difflcounts($ids) [list $noldlines($ids)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2508
		    set noldlines($ids) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2509
		    set nnewlines($ids) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2510
		    set diffinhunk($ids) 2
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2511
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2512
		if {$match eq "-"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2513
		    incr noldlines($ids)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2514
		} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2515
		    incr nnewlines($ids)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2516
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2517
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2518
	    # and if it's \ No newline at end of line, then what?
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2519
	    return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2520
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2521
	# end of a hunk
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2522
	if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2523
	    lappend difflcounts($ids) [list $noldlines($ids)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2524
	} elseif {$diffinhunk($ids) == 2
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2525
		  && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2526
	    lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2527
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2528
	set currenthunk($ids) [list $currentfile($ids) \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2529
				   $diffoldstart($ids) $diffnewstart($ids) \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2530
				   $diffoldlno($ids) $diffnewlno($ids) \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2531
				   $difflcounts($ids)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2532
	set diffinhunk($ids) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2533
	# -1 = need to block, 0 = unblocked, 1 = is blocked
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2534
	set diffblocked($ids) -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2535
	processhunks
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2536
	if {$diffblocked($ids) == -1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2537
	    fileevent $f readable {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2538
	    set diffblocked($ids) 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2539
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2540
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2541
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2542
    if {$n < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2543
	# eof
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2544
	if {!$diffblocked($ids)} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2545
	    close $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2546
	    set currentfile($ids) [llength $mergefilelist($diffmergeid)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2547
	    set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2548
	    processhunks
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2549
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2550
    } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2551
	# start of a new file
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2552
	set currentfile($ids) \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2553
	    [lsearch -exact $mergefilelist($diffmergeid) $fname]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2554
    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2555
		   $line match f1l f1c f2l f2c rest]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2556
	if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2557
	    # start of a new hunk
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2558
	    if {$f1l == 0 && $f1c == 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2559
		set f1l 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2560
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2561
	    if {$f2l == 0 && $f2c == 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2562
		set f2l 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2563
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2564
	    set diffinhunk($ids) 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2565
	    set diffoldstart($ids) $f1l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2566
	    set diffnewstart($ids) $f2l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2567
	    set diffoldlno($ids) $f1l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2568
	    set diffnewlno($ids) $f2l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2569
	    set difflcounts($ids) {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2570
	    set noldlines($ids) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2571
	    set nnewlines($ids) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2572
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2573
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2574
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2575
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2576
proc processhunks {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2577
    global diffmergeid parents nparents currenthunk
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2578
    global mergefilelist diffblocked mergefds
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2579
    global grouphunks grouplinestart grouplineend groupfilenum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2580
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2581
    set nfiles [llength $mergefilelist($diffmergeid)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2582
    while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2583
	set fi $nfiles
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2584
	set lno 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2585
	# look for the earliest hunk
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2586
	foreach p $parents($diffmergeid) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2587
	    set ids [list $diffmergeid $p]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2588
	    if {![info exists currenthunk($ids)]} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2589
	    set i [lindex $currenthunk($ids) 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2590
	    set l [lindex $currenthunk($ids) 2]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2591
	    if {$i < $fi || ($i == $fi && $l < $lno)} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2592
		set fi $i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2593
		set lno $l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2594
		set pi $p
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2595
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2596
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2597
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2598
	if {$fi < $nfiles} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2599
	    set ids [list $diffmergeid $pi]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2600
	    set hunk $currenthunk($ids)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2601
	    unset currenthunk($ids)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2602
	    if {$diffblocked($ids) > 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2603
		fileevent $mergefds($ids) readable \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2604
		    [list getmergediffline $mergefds($ids) $ids $diffmergeid]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2605
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2606
	    set diffblocked($ids) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2607
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2608
	    if {[info exists groupfilenum] && $groupfilenum == $fi
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2609
		&& $lno <= $grouplineend} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2610
		# add this hunk to the pending group
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2611
		lappend grouphunks($pi) $hunk
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2612
		set endln [lindex $hunk 4]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2613
		if {$endln > $grouplineend} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2614
		    set grouplineend $endln
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2615
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2616
		continue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2617
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2618
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2619
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2620
	# succeeding stuff doesn't belong in this group, so
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2621
	# process the group now
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2622
	if {[info exists groupfilenum]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2623
	    processgroup
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2624
	    unset groupfilenum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2625
	    unset grouphunks
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2626
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2627
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2628
	if {$fi >= $nfiles} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2629
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2630
	# start a new group
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2631
	set groupfilenum $fi
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2632
	set grouphunks($pi) [list $hunk]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2633
	set grouplinestart $lno
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2634
	set grouplineend [lindex $hunk 4]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2635
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2636
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2637
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2638
proc processgroup {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2639
    global groupfilelast groupfilenum difffilestart
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2640
    global mergefilelist diffmergeid ctext filelines
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2641
    global parents diffmergeid diffoffset
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2642
    global grouphunks grouplinestart grouplineend nparents
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2643
    global mergemax
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2644
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2645
    $ctext conf -state normal
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2646
    set id $diffmergeid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2647
    set f $groupfilenum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2648
    if {$groupfilelast != $f} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2649
	$ctext insert end "\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2650
	set here [$ctext index "end - 1c"]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2651
	set difffilestart($f) $here
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2652
	set mark fmark.[expr {$f + 1}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2653
	$ctext mark set $mark $here
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2654
	$ctext mark gravity $mark left
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2655
	set header [lindex $mergefilelist($id) $f]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2656
	set l [expr {(78 - [string length $header]) / 2}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2657
	set pad [string range "----------------------------------------" 1 $l]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2658
	$ctext insert end "$pad $header $pad\n" filesep
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2659
	set groupfilelast $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2660
	foreach p $parents($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2661
	    set diffoffset($p) 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2662
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2663
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2664
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2665
    $ctext insert end "@@" msep
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2666
    set nlines [expr {$grouplineend - $grouplinestart}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2667
    set events {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2668
    set pnum 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2669
    foreach p $parents($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2670
	set startline [expr {$grouplinestart + $diffoffset($p)}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2671
	set ol $startline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2672
	set nl $grouplinestart
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2673
	if {[info exists grouphunks($p)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2674
	    foreach h $grouphunks($p) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2675
		set l [lindex $h 2]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2676
		if {$nl < $l} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2677
		    for {} {$nl < $l} {incr nl} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2678
			set filelines($p,$f,$ol) $filelines($id,$f,$nl)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2679
			incr ol
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2680
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2681
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2682
		foreach chunk [lindex $h 5] {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2683
		    if {[llength $chunk] == 2} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2684
			set olc [lindex $chunk 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2685
			set nlc [lindex $chunk 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2686
			set nnl [expr {$nl + $nlc}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2687
			lappend events [list $nl $nnl $pnum $olc $nlc]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2688
			incr ol $olc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2689
			set nl $nnl
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2690
		    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2691
			incr ol [lindex $chunk 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2692
			incr nl [lindex $chunk 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2693
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2694
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2695
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2696
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2697
	if {$nl < $grouplineend} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2698
	    for {} {$nl < $grouplineend} {incr nl} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2699
		set filelines($p,$f,$ol) $filelines($id,$f,$nl)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2700
		incr ol
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2701
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2702
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2703
	set nlines [expr {$ol - $startline}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2704
	$ctext insert end " -$startline,$nlines" msep
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2705
	incr pnum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2706
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2707
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2708
    set nlines [expr {$grouplineend - $grouplinestart}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2709
    $ctext insert end " +$grouplinestart,$nlines @@\n" msep
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2710
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2711
    set events [lsort -integer -index 0 $events]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2712
    set nevents [llength $events]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2713
    set nmerge $nparents($diffmergeid)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2714
    set l $grouplinestart
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2715
    for {set i 0} {$i < $nevents} {set i $j} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2716
	set nl [lindex $events $i 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2717
	while {$l < $nl} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2718
	    $ctext insert end " $filelines($id,$f,$l)\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2719
	    incr l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2720
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2721
	set e [lindex $events $i]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2722
	set enl [lindex $e 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2723
	set j $i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2724
	set active {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2725
	while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2726
	    set pnum [lindex $e 2]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2727
	    set olc [lindex $e 3]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2728
	    set nlc [lindex $e 4]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2729
	    if {![info exists delta($pnum)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2730
		set delta($pnum) [expr {$olc - $nlc}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2731
		lappend active $pnum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2732
	    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2733
		incr delta($pnum) [expr {$olc - $nlc}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2734
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2735
	    if {[incr j] >= $nevents} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2736
	    set e [lindex $events $j]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2737
	    if {[lindex $e 0] >= $enl} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2738
	    if {[lindex $e 1] > $enl} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2739
		set enl [lindex $e 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2740
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2741
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2742
	set nlc [expr {$enl - $l}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2743
	set ncol mresult
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2744
	set bestpn -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2745
	if {[llength $active] == $nmerge - 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2746
	    # no diff for one of the parents, i.e. it's identical
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2747
	    for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2748
		if {![info exists delta($pnum)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2749
		    if {$pnum < $mergemax} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2750
			lappend ncol m$pnum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2751
		    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2752
			lappend ncol mmax
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2753
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2754
		    break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2755
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2756
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2757
	} elseif {[llength $active] == $nmerge} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2758
	    # all parents are different, see if one is very similar
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2759
	    set bestsim 30
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2760
	    for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2761
		set sim [similarity $pnum $l $nlc $f \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2762
			     [lrange $events $i [expr {$j-1}]]]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2763
		if {$sim > $bestsim} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2764
		    set bestsim $sim
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2765
		    set bestpn $pnum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2766
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2767
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2768
	    if {$bestpn >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2769
		lappend ncol m$bestpn
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2770
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2771
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2772
	set pnum -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2773
	foreach p $parents($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2774
	    incr pnum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2775
	    if {![info exists delta($pnum)] || $pnum == $bestpn} continue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2776
	    set olc [expr {$nlc + $delta($pnum)}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2777
	    set ol [expr {$l + $diffoffset($p)}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2778
	    incr diffoffset($p) $delta($pnum)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2779
	    unset delta($pnum)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2780
	    for {} {$olc > 0} {incr olc -1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2781
		$ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2782
		incr ol
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2783
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2784
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2785
	set endl [expr {$l + $nlc}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2786
	if {$bestpn >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2787
	    # show this pretty much as a normal diff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2788
	    set p [lindex $parents($id) $bestpn]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2789
	    set ol [expr {$l + $diffoffset($p)}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2790
	    incr diffoffset($p) $delta($bestpn)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2791
	    unset delta($bestpn)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2792
	    for {set k $i} {$k < $j} {incr k} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2793
		set e [lindex $events $k]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2794
		if {[lindex $e 2] != $bestpn} continue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2795
		set nl [lindex $e 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2796
		set ol [expr {$ol + $nl - $l}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2797
		for {} {$l < $nl} {incr l} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2798
		    $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2799
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2800
		set c [lindex $e 3]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2801
		for {} {$c > 0} {incr c -1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2802
		    $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2803
		    incr ol
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2804
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2805
		set nl [lindex $e 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2806
		for {} {$l < $nl} {incr l} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2807
		    $ctext insert end "+$filelines($id,$f,$l)\n" mresult
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2808
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2809
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2810
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2811
	for {} {$l < $endl} {incr l} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2812
	    $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2813
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2814
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2815
    while {$l < $grouplineend} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2816
	$ctext insert end " $filelines($id,$f,$l)\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2817
	incr l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2818
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2819
    $ctext conf -state disabled
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2820
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2821
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2822
proc similarity {pnum l nlc f events} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2823
    global diffmergeid parents diffoffset filelines
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2824
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2825
    set id $diffmergeid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2826
    set p [lindex $parents($id) $pnum]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2827
    set ol [expr {$l + $diffoffset($p)}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2828
    set endl [expr {$l + $nlc}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2829
    set same 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2830
    set diff 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2831
    foreach e $events {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2832
	if {[lindex $e 2] != $pnum} continue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2833
	set nl [lindex $e 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2834
	set ol [expr {$ol + $nl - $l}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2835
	for {} {$l < $nl} {incr l} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2836
	    incr same [string length $filelines($id,$f,$l)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2837
	    incr same
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2838
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2839
	set oc [lindex $e 3]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2840
	for {} {$oc > 0} {incr oc -1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2841
	    incr diff [string length $filelines($p,$f,$ol)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2842
	    incr diff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2843
	    incr ol
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2844
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2845
	set nl [lindex $e 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2846
	for {} {$l < $nl} {incr l} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2847
	    incr diff [string length $filelines($id,$f,$l)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2848
	    incr diff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2849
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2850
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2851
    for {} {$l < $endl} {incr l} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2852
	incr same [string length $filelines($id,$f,$l)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2853
	incr same
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2854
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2855
    if {$same == 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2856
	return 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2857
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2858
    return [expr {200 * $same / (2 * $same + $diff)}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2859
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2860
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2861
proc startdiff {ids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2862
    global treediffs diffids treepending diffmergeid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2863
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2864
    set diffids $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2865
    catch {unset diffmergeid}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2866
    if {![info exists treediffs($ids)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2867
	if {![info exists treepending]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2868
	    gettreediffs $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2869
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2870
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2871
	addtocflist $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2872
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2873
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2874
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2875
proc addtocflist {ids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2876
    global treediffs cflist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2877
    foreach f $treediffs($ids) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2878
	$cflist insert end $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2879
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2880
    getblobdiffs $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2881
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2882
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2883
proc gettreediffs {ids} {
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
  2884
    global treediff parents treepending env
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2885
    set treepending $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2886
    set treediff {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2887
    set id [lindex $ids 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2888
    set p [lindex $ids 1]
4740
e1d1b22bab57 Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4688
diff changeset
  2889
    if [catch {set gdtf [open "|{$env(HG)} --config ui.report_untrusted=false debug-diff-tree -r $p $id" r]}] return
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2890
    fconfigure $gdtf -blocking 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2891
    fileevent $gdtf readable [list gettreediffline $gdtf $ids]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2892
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2893
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2894
proc gettreediffline {gdtf ids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2895
    global treediff treediffs treepending diffids diffmergeid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2896
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2897
    set n [gets $gdtf line]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2898
    if {$n < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2899
	if {![eof $gdtf]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2900
	close $gdtf
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2901
	set treediffs($ids) $treediff
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2902
	unset treepending
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2903
	if {$ids != $diffids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2904
	    gettreediffs $diffids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2905
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2906
	    if {[info exists diffmergeid]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2907
		contmergediff $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2908
	    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2909
		addtocflist $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2910
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2911
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2912
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2913
    }
4741
4a84f7421692 Make hgk handle filenames with spaces (issue49)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4740
diff changeset
  2914
    set tab1 [expr [string first "\t" $line] + 1]
4a84f7421692 Make hgk handle filenames with spaces (issue49)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4740
diff changeset
  2915
    set tab2 [expr [string first "\t" $line $tab1] - 1]
4a84f7421692 Make hgk handle filenames with spaces (issue49)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4740
diff changeset
  2916
    set file [string range $line $tab1 $tab2]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2917
    lappend treediff $file
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2918
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2919
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2920
proc getblobdiffs {ids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2921
    global diffopts blobdifffd diffids env curdifftag curtagstart
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2922
    global difffilestart nextupdate diffinhdr treediffs
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2923
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2924
    set id [lindex $ids 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2925
    set p [lindex $ids 1]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2926
    set env(GIT_DIFF_OPTS) $diffopts
4740
e1d1b22bab57 Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4688
diff changeset
  2927
    set cmd [list | $env(HG) --config ui.report_untrusted=false debug-diff-tree -r -p -C $p $id]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2928
    if {[catch {set bdf [open $cmd r]} err]} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2929
	puts "error getting diffs: $err"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2930
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2931
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2932
    set diffinhdr 0
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2933
    fconfigure $bdf -blocking 0
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2934
    set blobdifffd($ids) $bdf
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2935
    set curdifftag Comments
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2936
    set curtagstart 0.0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2937
    catch {unset difffilestart}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2938
    fileevent $bdf readable [list getblobdiffline $bdf $diffids]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2939
    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2940
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2941
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2942
proc getblobdiffline {bdf ids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2943
    global diffids blobdifffd ctext curdifftag curtagstart
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2944
    global diffnexthead diffnextnote difffilestart
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2945
    global nextupdate diffinhdr treediffs
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2946
    global gaudydiff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2947
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2948
    set n [gets $bdf line]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2949
    if {$n < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2950
	if {[eof $bdf]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2951
	    close $bdf
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2952
	    if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2953
		$ctext tag add $curdifftag $curtagstart end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2954
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2955
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2956
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2957
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2958
    if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2959
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2960
    }
3940
a33ddd20105c hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents: 3093
diff changeset
  2961
    regsub -all "\r" $line "" line
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2962
    $ctext conf -state normal
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2963
    if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2964
	# start of a new file
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2965
	$ctext insert end "\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2966
	$ctext tag add $curdifftag $curtagstart end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2967
	set curtagstart [$ctext index "end - 1c"]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2968
	set header $newname
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2969
	set here [$ctext index "end - 1c"]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2970
	set i [lsearch -exact $treediffs($diffids) $fname]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2971
	if {$i >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2972
	    set difffilestart($i) $here
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2973
	    incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2974
	    $ctext mark set fmark.$i $here
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2975
	    $ctext mark gravity fmark.$i left
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2976
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2977
	if {$newname != $fname} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2978
	    set i [lsearch -exact $treediffs($diffids) $newname]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2979
	    if {$i >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2980
		set difffilestart($i) $here
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2981
		incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2982
		$ctext mark set fmark.$i $here
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2983
		$ctext mark gravity fmark.$i left
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2984
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2985
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2986
	set curdifftag "f:$fname"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2987
	$ctext tag delete $curdifftag
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2988
	set l [expr {(78 - [string length $header]) / 2}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2989
	set pad [string range "----------------------------------------" 1 $l]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2990
	$ctext insert end "$pad $header $pad\n" filesep
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2991
	set diffinhdr 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2992
    } elseif {[regexp {^(---|\+\+\+)} $line]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2993
	set diffinhdr 0
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2994
    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2995
		   $line match f1l f1c f2l f2c rest]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2996
	if {$gaudydiff} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2997
	    $ctext insert end "\t" hunksep
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2998
	    $ctext insert end "    $f1l    " d0 "    $f2l    " d1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2999
	    $ctext insert end "    $rest \n" hunksep
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3000
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3001
	    $ctext insert end "$line\n" hunksep
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3002
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3003
	set diffinhdr 0
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3004
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3005
	set x [string range $line 0 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3006
	if {$x == "-" || $x == "+"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3007
	    set tag [expr {$x == "+"}]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3008
	    if {$gaudydiff} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3009
		set line [string range $line 1 end]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3010
	    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3011
	    $ctext insert end "$line\n" d$tag
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3012
	} elseif {$x == " "} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3013
	    if {$gaudydiff} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3014
		set line [string range $line 1 end]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3015
	    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3016
	    $ctext insert end "$line\n"
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3017
	} elseif {$diffinhdr || $x == "\\"} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3018
	    # e.g. "\ No newline at end of file"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3019
	    $ctext insert end "$line\n" filesep
3940
a33ddd20105c hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents: 3093
diff changeset
  3020
	} elseif  {$line != ""} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3021
	    # Something else we don't recognize
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3022
	    if {$curdifftag != "Comments"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3023
		$ctext insert end "\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3024
		$ctext tag add $curdifftag $curtagstart end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3025
		set curtagstart [$ctext index "end - 1c"]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3026
		set curdifftag Comments
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3027
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3028
	    $ctext insert end "$line\n" filesep
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3029
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3030
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3031
    $ctext conf -state disabled
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3032
    if {[clock clicks -milliseconds] >= $nextupdate} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3033
	incr nextupdate 100
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3034
	fileevent $bdf readable {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3035
	update
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3036
	fileevent $bdf readable "getblobdiffline $bdf {$ids}"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3037
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3038
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3039
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3040
proc nextfile {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3041
    global difffilestart ctext
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3042
    set here [$ctext index @0,0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3043
    for {set i 0} {[info exists difffilestart($i)]} {incr i} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3044
	if {[$ctext compare $difffilestart($i) > $here]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3045
	    if {![info exists pos]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3046
		|| [$ctext compare $difffilestart($i) < $pos]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3047
		set pos $difffilestart($i)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3048
	    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3049
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3050
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3051
    if {[info exists pos]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3052
	$ctext yview $pos
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3053
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3054
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3055
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3056
proc listboxsel {} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3057
    global ctext cflist currentid
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3058
    if {![info exists currentid]} return
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3059
    set sel [lsort [$cflist curselection]]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3060
    if {$sel eq {}} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3061
    set first [lindex $sel 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3062
    catch {$ctext yview fmark.$first}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3063
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3064
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3065
proc setcoords {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3066
    global linespc charspc canvx0 canvy0 mainfont
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3067
    global xspc1 xspc2 lthickness
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3068
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3069
    set linespc [font metrics $mainfont -linespace]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3070
    set charspc [font measure $mainfont "m"]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3071
    set canvy0 [expr 3 + 0.5 * $linespc]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3072
    set canvx0 [expr 3 + 0.5 * $linespc]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3073
    set lthickness [expr {int($linespc / 9) + 1}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3074
    set xspc1(0) $linespc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3075
    set xspc2 $linespc
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3076
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3077
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3078
proc redisplay {} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3079
    global stopped redisplaying phase
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3080
    if {$stopped > 1} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3081
    if {$phase == "getcommits"} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3082
    set redisplaying 1
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3083
    if {$phase == "drawgraph" || $phase == "incrdraw"} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3084
	set stopped 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3085
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3086
	drawgraph
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3087
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3088
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3089
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3090
proc incrfont {inc} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3091
    global mainfont namefont textfont ctext canv phase
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3092
    global stopped entries
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3093
    unmarkmatches
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3094
    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3095
    set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3096
    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3097
    setcoords
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3098
    $ctext conf -font $textfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3099
    $ctext tag conf filesep -font [concat $textfont bold]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3100
    foreach e $entries {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3101
	$e conf -font $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3102
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3103
    if {$phase == "getcommits"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3104
	$canv itemconf textitems -font $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3105
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3106
    redisplay
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3107
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3108
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3109
proc clearsha1 {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3110
    global sha1entry sha1string
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3111
    if {[string length $sha1string] == 40} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3112
	$sha1entry delete 0 end
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3113
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3114
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3115
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3116
proc sha1change {n1 n2 op} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3117
    global sha1string currentid sha1but
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3118
    if {$sha1string == {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3119
	|| ([info exists currentid] && $sha1string == $currentid)} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3120
	set state disabled
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3121
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3122
	set state normal
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3123
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3124
    if {[$sha1but cget -state] == $state} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3125
    if {$state == "normal"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3126
	$sha1but conf -state normal -relief raised -text "Goto: "
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3127
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3128
	$sha1but conf -state disabled -relief flat -text "SHA1 ID: "
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3129
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3130
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3131
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3132
proc gotocommit {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3133
    global sha1string currentid idline tagids
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3134
    global lineid numcommits
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3135
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3136
    if {$sha1string == {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3137
	|| ([info exists currentid] && $sha1string == $currentid)} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3138
    if {[info exists tagids($sha1string)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3139
	set id $tagids($sha1string)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3140
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3141
	set id [string tolower $sha1string]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3142
	if {[regexp {^[0-9a-f]{4,39}$} $id]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3143
	    set matches {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3144
	    for {set l 0} {$l < $numcommits} {incr l} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3145
		if {[string match $id* $lineid($l)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3146
		    lappend matches $lineid($l)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3147
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3148
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3149
	    if {$matches ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3150
		if {[llength $matches] > 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3151
		    error_popup "Short SHA1 id $id is ambiguous"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3152
		    return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3153
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3154
		set id [lindex $matches 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3155
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3156
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3157
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3158
    if {[info exists idline($id)]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3159
	selectline $idline($id) 1
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3160
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3161
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3162
    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3163
	set type "SHA1 id"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3164
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3165
	set type "Tag"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3166
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3167
    error_popup "$type $sha1string is not known"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3168
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3169
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3170
proc lineenter {x y id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3171
    global hoverx hovery hoverid hovertimer
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3172
    global commitinfo canv
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3173
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3174
    if {![info exists commitinfo($id)]} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3175
    set hoverx $x
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3176
    set hovery $y
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3177
    set hoverid $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3178
    if {[info exists hovertimer]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3179
	after cancel $hovertimer
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3180
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3181
    set hovertimer [after 500 linehover]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3182
    $canv delete hover
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3183
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3184
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3185
proc linemotion {x y id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3186
    global hoverx hovery hoverid hovertimer
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3187
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3188
    if {[info exists hoverid] && $id == $hoverid} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3189
	set hoverx $x
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3190
	set hovery $y
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3191
	if {[info exists hovertimer]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3192
	    after cancel $hovertimer
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3193
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3194
	set hovertimer [after 500 linehover]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3195
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3196
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3197
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3198
proc lineleave {id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3199
    global hoverid hovertimer canv
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3200
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3201
    if {[info exists hoverid] && $id == $hoverid} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3202
	$canv delete hover
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3203
	if {[info exists hovertimer]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3204
	    after cancel $hovertimer
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3205
	    unset hovertimer
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3206
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3207
	unset hoverid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3208
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3209
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3210
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3211
proc linehover {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3212
    global hoverx hovery hoverid hovertimer
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3213
    global canv linespc lthickness
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3214
    global commitinfo mainfont
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3215
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3216
    set text [lindex $commitinfo($hoverid) 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3217
    set ymax [lindex [$canv cget -scrollregion] 3]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3218
    if {$ymax == {}} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3219
    set yfrac [lindex [$canv yview] 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3220
    set x [expr {$hoverx + 2 * $linespc}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3221
    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3222
    set x0 [expr {$x - 2 * $lthickness}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3223
    set y0 [expr {$y - 2 * $lthickness}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3224
    set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3225
    set y1 [expr {$y + $linespc + 2 * $lthickness}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3226
    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3227
	       -fill \#ffff80 -outline black -width 1 -tags hover]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3228
    $canv raise $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3229
    set t [$canv create text $x $y -anchor nw -text $text -tags hover]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3230
    $canv raise $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3231
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3232
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3233
proc clickisonarrow {id y} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3234
    global mainline mainlinearrow sidelines lthickness
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3235
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3236
    set thresh [expr {2 * $lthickness + 6}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3237
    if {[info exists mainline($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3238
	if {$mainlinearrow($id) ne "none"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3239
	    if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3240
		return "up"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3241
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3242
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3243
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3244
    if {[info exists sidelines($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3245
	foreach ls $sidelines($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3246
	    set coords [lindex $ls 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3247
	    set arrow [lindex $ls 2]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3248
	    if {$arrow eq "first" || $arrow eq "both"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3249
		if {abs([lindex $coords 1] - $y) < $thresh} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3250
		    return "up"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3251
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3252
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3253
	    if {$arrow eq "last" || $arrow eq "both"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3254
		if {abs([lindex $coords end] - $y) < $thresh} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3255
		    return "down"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3256
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3257
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3258
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3259
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3260
    return {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3261
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3262
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3263
proc arrowjump {id dirn y} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3264
    global mainline sidelines canv
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3265
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3266
    set yt {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3267
    if {$dirn eq "down"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3268
	if {[info exists mainline($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3269
	    set y1 [lindex $mainline($id) 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3270
	    if {$y1 > $y} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3271
		set yt $y1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3272
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3273
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3274
	if {[info exists sidelines($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3275
	    foreach ls $sidelines($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3276
		set y1 [lindex $ls 0 1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3277
		if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3278
		    set yt $y1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3279
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3280
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3281
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3282
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3283
	if {[info exists sidelines($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3284
	    foreach ls $sidelines($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3285
		set y1 [lindex $ls 0 end]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3286
		if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3287
		    set yt $y1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3288
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3289
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3290
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3291
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3292
    if {$yt eq {}} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3293
    set ymax [lindex [$canv cget -scrollregion] 3]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3294
    if {$ymax eq {} || $ymax <= 0} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3295
    set view [$canv yview]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3296
    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3297
    set yfrac [expr {$yt / $ymax - $yspan / 2}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3298
    if {$yfrac < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3299
	set yfrac 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3300
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3301
    $canv yview moveto $yfrac
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3302
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3303
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3304
proc lineclick {x y id isnew} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3305
    global ctext commitinfo children cflist canv thickerline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3306
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3307
    unmarkmatches
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3308
    unselectline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3309
    normalline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3310
    $canv delete hover
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3311
    # draw this line thicker than normal
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3312
    drawlines $id 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3313
    set thickerline $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3314
    if {$isnew} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3315
	set ymax [lindex [$canv cget -scrollregion] 3]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3316
	if {$ymax eq {}} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3317
	set yfrac [lindex [$canv yview] 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3318
	set y [expr {$y + $yfrac * $ymax}]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3319
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3320
    set dirn [clickisonarrow $id $y]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3321
    if {$dirn ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3322
	arrowjump $id $dirn $y
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3323
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3324
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3325
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3326
    if {$isnew} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3327
	addtohistory [list lineclick $x $y $id 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3328
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3329
    # fill the details pane with info about this line
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3330
    $ctext conf -state normal
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3331
    $ctext delete 0.0 end
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3332
    $ctext tag conf link -foreground blue -underline 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3333
    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3334
    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3335
    $ctext insert end "Parent:\t"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3336
    $ctext insert end $id [list link link0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3337
    $ctext tag bind link0 <1> [list selbyid $id]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3338
    set info $commitinfo($id)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3339
    $ctext insert end "\n\t[lindex $info 0]\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3340
    $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3341
    $ctext insert end "\tDate:\t[lindex $info 2]\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3342
    if {[info exists children($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3343
	$ctext insert end "\nChildren:"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3344
	set i 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3345
	foreach child $children($id) {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3346
	    incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3347
	    set info $commitinfo($child)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3348
	    $ctext insert end "\n\t"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3349
	    $ctext insert end $child [list link link$i]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3350
	    $ctext tag bind link$i <1> [list selbyid $child]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3351
	    $ctext insert end "\n\t[lindex $info 0]"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3352
	    $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3353
	    $ctext insert end "\n\tDate:\t[lindex $info 2]\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3354
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3355
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3356
    $ctext conf -state disabled
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3357
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3358
    $cflist delete 0 end
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3359
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3360
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3361
proc normalline {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3362
    global thickerline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3363
    if {[info exists thickerline]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3364
	drawlines $thickerline 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3365
	unset thickerline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3366
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3367
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3368
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3369
proc selbyid {id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3370
    global idline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3371
    if {[info exists idline($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3372
	selectline $idline($id) 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3373
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3374
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3375
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3376
proc mstime {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3377
    global startmstime
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3378
    if {![info exists startmstime]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3379
	set startmstime [clock clicks -milliseconds]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3380
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3381
    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3382
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3383
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3384
proc rowmenu {x y id} {
5394
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3385
    global rowctxmenu idline selectedline rowmenuid hgvdiff
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3386
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3387
    if {![info exists selectedline] || $idline($id) eq $selectedline} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3388
	set state disabled
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3389
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3390
	set state normal
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3391
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3392
    $rowctxmenu entryconfigure 0 -state $state
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3393
    $rowctxmenu entryconfigure 1 -state $state
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3394
    $rowctxmenu entryconfigure 2 -state $state
5394
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3395
    if { $hgvdiff ne "" } {
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3396
	$rowctxmenu entryconfigure 6 -state $state
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3397
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3398
    set rowmenuid $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3399
    tk_popup $rowctxmenu $x $y
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3400
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3401
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3402
proc diffvssel {dirn} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3403
    global rowmenuid selectedline lineid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3404
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3405
    if {![info exists selectedline]} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3406
    if {$dirn} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3407
	set oldid $lineid($selectedline)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3408
	set newid $rowmenuid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3409
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3410
	set oldid $rowmenuid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3411
	set newid $lineid($selectedline)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3412
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3413
    addtohistory [list doseldiff $oldid $newid]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3414
    doseldiff $oldid $newid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3415
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3416
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3417
proc doseldiff {oldid newid} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3418
    global ctext cflist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3419
    global commitinfo
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3420
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3421
    $ctext conf -state normal
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3422
    $ctext delete 0.0 end
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3423
    $ctext mark set fmark.0 0.0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3424
    $ctext mark gravity fmark.0 left
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3425
    $cflist delete 0 end
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3426
    $cflist insert end "Top"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3427
    $ctext insert end "From "
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3428
    $ctext tag conf link -foreground blue -underline 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3429
    $ctext tag bind link <Enter> { %W configure -cursor hand2 }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3430
    $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3431
    $ctext tag bind link0 <1> [list selbyid $oldid]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3432
    $ctext insert end $oldid [list link link0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3433
    $ctext insert end "\n     "
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3434
    $ctext insert end [lindex $commitinfo($oldid) 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3435
    $ctext insert end "\n\nTo   "
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3436
    $ctext tag bind link1 <1> [list selbyid $newid]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3437
    $ctext insert end $newid [list link link1]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3438
    $ctext insert end "\n     "
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3439
    $ctext insert end [lindex $commitinfo($newid) 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3440
    $ctext insert end "\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3441
    $ctext conf -state disabled
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3442
    $ctext tag delete Comments
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3443
    $ctext tag remove found 1.0 end
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3444
    startdiff [list $newid $oldid]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3445
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3446
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3447
proc mkpatch {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3448
    global rowmenuid currentid commitinfo patchtop patchnum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3449
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3450
    if {![info exists currentid]} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3451
    set oldid $currentid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3452
    set oldhead [lindex $commitinfo($oldid) 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3453
    set newid $rowmenuid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3454
    set newhead [lindex $commitinfo($newid) 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3455
    set top .patch
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3456
    set patchtop $top
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3457
    catch {destroy $top}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3458
    toplevel $top
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3459
    label $top.title -text "Generate patch"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3460
    grid $top.title - -pady 10
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3461
    label $top.from -text "From:"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3462
    entry $top.fromsha1 -width 40 -relief flat
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3463
    $top.fromsha1 insert 0 $oldid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3464
    $top.fromsha1 conf -state readonly
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3465
    grid $top.from $top.fromsha1 -sticky w
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3466
    entry $top.fromhead -width 60 -relief flat
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3467
    $top.fromhead insert 0 $oldhead
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3468
    $top.fromhead conf -state readonly
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3469
    grid x $top.fromhead -sticky w
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3470
    label $top.to -text "To:"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3471
    entry $top.tosha1 -width 40 -relief flat
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3472
    $top.tosha1 insert 0 $newid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3473
    $top.tosha1 conf -state readonly
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3474
    grid $top.to $top.tosha1 -sticky w
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3475
    entry $top.tohead -width 60 -relief flat
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3476
    $top.tohead insert 0 $newhead
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3477
    $top.tohead conf -state readonly
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3478
    grid x $top.tohead -sticky w
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3479
    button $top.rev -text "Reverse" -command mkpatchrev -padx 5
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3480
    grid $top.rev x -pady 10
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3481
    label $top.flab -text "Output file:"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3482
    entry $top.fname -width 60
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3483
    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3484
    incr patchnum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3485
    grid $top.flab $top.fname -sticky w
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3486
    frame $top.buts
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3487
    button $top.buts.gen -text "Generate" -command mkpatchgo
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3488
    button $top.buts.can -text "Cancel" -command mkpatchcan
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3489
    grid $top.buts.gen $top.buts.can
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3490
    grid columnconfigure $top.buts 0 -weight 1 -uniform a
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3491
    grid columnconfigure $top.buts 1 -weight 1 -uniform a
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3492
    grid $top.buts - -pady 10 -sticky ew
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3493
    focus $top.fname
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3494
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3495
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3496
proc mkpatchrev {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3497
    global patchtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3498
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3499
    set oldid [$patchtop.fromsha1 get]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3500
    set oldhead [$patchtop.fromhead get]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3501
    set newid [$patchtop.tosha1 get]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3502
    set newhead [$patchtop.tohead get]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3503
    foreach e [list fromsha1 fromhead tosha1 tohead] \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3504
	    v [list $newid $newhead $oldid $oldhead] {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3505
	$patchtop.$e conf -state normal
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3506
	$patchtop.$e delete 0 end
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3507
	$patchtop.$e insert 0 $v
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3508
	$patchtop.$e conf -state readonly
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3509
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3510
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3511
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3512
proc mkpatchgo {} {
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
  3513
    global patchtop env
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3514
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3515
    set oldid [$patchtop.fromsha1 get]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3516
    set newid [$patchtop.tosha1 get]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3517
    set fname [$patchtop.fname get]
4740
e1d1b22bab57 Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4688
diff changeset
  3518
    if {[catch {exec $env(HG) --config ui.report_untrusted=false debug-diff-tree -p $oldid $newid >$fname &} err]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3519
	error_popup "Error creating patch: $err"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3520
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3521
    catch {destroy $patchtop}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3522
    unset patchtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3523
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3524
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3525
proc mkpatchcan {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3526
    global patchtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3527
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3528
    catch {destroy $patchtop}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3529
    unset patchtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3530
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3531
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3532
proc mktag {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3533
    global rowmenuid mktagtop commitinfo
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3534
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3535
    set top .maketag
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3536
    set mktagtop $top
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3537
    catch {destroy $top}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3538
    toplevel $top
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3539
    label $top.title -text "Create tag"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3540
    grid $top.title - -pady 10
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3541
    label $top.id -text "ID:"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3542
    entry $top.sha1 -width 40 -relief flat
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3543
    $top.sha1 insert 0 $rowmenuid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3544
    $top.sha1 conf -state readonly
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3545
    grid $top.id $top.sha1 -sticky w
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3546
    entry $top.head -width 60 -relief flat
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3547
    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3548
    $top.head conf -state readonly
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3549
    grid x $top.head -sticky w
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3550
    label $top.tlab -text "Tag name:"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3551
    entry $top.tag -width 60
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3552
    grid $top.tlab $top.tag -sticky w
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3553
    frame $top.buts
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3554
    button $top.buts.gen -text "Create" -command mktaggo
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3555
    button $top.buts.can -text "Cancel" -command mktagcan
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3556
    grid $top.buts.gen $top.buts.can
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3557
    grid columnconfigure $top.buts 0 -weight 1 -uniform a
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3558
    grid columnconfigure $top.buts 1 -weight 1 -uniform a
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3559
    grid $top.buts - -pady 10 -sticky ew
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3560
    focus $top.tag
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3561
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3562
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3563
proc domktag {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3564
    global mktagtop env tagids idtags
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3565
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3566
    set id [$mktagtop.sha1 get]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3567
    set tag [$mktagtop.tag get]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3568
    if {$tag == {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3569
	error_popup "No tag name specified"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3570
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3571
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3572
    if {[info exists tagids($tag)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3573
	error_popup "Tag \"$tag\" already exists"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3574
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3575
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3576
    if {[catch {
4740
e1d1b22bab57 Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4688
diff changeset
  3577
	set out [exec $env(HG) --config ui.report_untrusted=false tag -r $id $tag]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3578
    } err]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3579
	error_popup "Error creating tag: $err"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3580
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3581
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3582
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3583
    set tagids($tag) $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3584
    lappend idtags($id) $tag
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3585
    redrawtags $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3586
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3587
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3588
proc redrawtags {id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3589
    global canv linehtag idline idpos selectedline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3590
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3591
    if {![info exists idline($id)]} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3592
    $canv delete tag.$id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3593
    set xt [eval drawtags $id $idpos($id)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3594
    $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3595
    if {[info exists selectedline] && $selectedline == $idline($id)} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3596
	selectline $selectedline 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3597
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3598
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3599
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3600
proc mktagcan {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3601
    global mktagtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3602
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3603
    catch {destroy $mktagtop}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3604
    unset mktagtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3605
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3606
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3607
proc mktaggo {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3608
    domktag
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3609
    mktagcan
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3610
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3611
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3612
proc writecommit {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3613
    global rowmenuid wrcomtop commitinfo wrcomcmd
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3614
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3615
    set top .writecommit
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3616
    set wrcomtop $top
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3617
    catch {destroy $top}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3618
    toplevel $top
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3619
    label $top.title -text "Write commit to file"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3620
    grid $top.title - -pady 10
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3621
    label $top.id -text "ID:"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3622
    entry $top.sha1 -width 40 -relief flat
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3623
    $top.sha1 insert 0 $rowmenuid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3624
    $top.sha1 conf -state readonly
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3625
    grid $top.id $top.sha1 -sticky w
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3626
    entry $top.head -width 60 -relief flat
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3627
    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3628
    $top.head conf -state readonly
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3629
    grid x $top.head -sticky w
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3630
    label $top.clab -text "Command:"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3631
    entry $top.cmd -width 60 -textvariable wrcomcmd
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3632
    grid $top.clab $top.cmd -sticky w -pady 10
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3633
    label $top.flab -text "Output file:"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3634
    entry $top.fname -width 60
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3635
    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3636
    grid $top.flab $top.fname -sticky w
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3637
    frame $top.buts
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3638
    button $top.buts.gen -text "Write" -command wrcomgo
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3639
    button $top.buts.can -text "Cancel" -command wrcomcan
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3640
    grid $top.buts.gen $top.buts.can
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3641
    grid columnconfigure $top.buts 0 -weight 1 -uniform a
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3642
    grid columnconfigure $top.buts 1 -weight 1 -uniform a
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3643
    grid $top.buts - -pady 10 -sticky ew
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3644
    focus $top.fname
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3645
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3646
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3647
proc wrcomgo {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3648
    global wrcomtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3649
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3650
    set id [$wrcomtop.sha1 get]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3651
    set cmd "echo $id | [$wrcomtop.cmd get]"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3652
    set fname [$wrcomtop.fname get]
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
  3653
    if {[catch {exec sh -c $cmd > $fname &} err]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3654
	error_popup "Error writing commit: $err"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3655
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3656
    catch {destroy $wrcomtop}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3657
    unset wrcomtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3658
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3659
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3660
proc wrcomcan {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3661
    global wrcomtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3662
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3663
    catch {destroy $wrcomtop}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3664
    unset wrcomtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3665
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3666
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3667
proc listrefs {id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3668
    global idtags idheads idotherrefs
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3669
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3670
    set x {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3671
    if {[info exists idtags($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3672
	set x $idtags($id)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3673
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3674
    set y {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3675
    if {[info exists idheads($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3676
	set y $idheads($id)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3677
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3678
    set z {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3679
    if {[info exists idotherrefs($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3680
	set z $idotherrefs($id)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3681
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3682
    return [list $x $y $z]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3683
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3684
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3685
proc rereadrefs {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3686
    global idtags idheads idotherrefs
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3687
    global tagids headids otherrefids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3688
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3689
    set refids [concat [array names idtags] \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3690
		    [array names idheads] [array names idotherrefs]]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3691
    foreach id $refids {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3692
	if {![info exists ref($id)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3693
	    set ref($id) [listrefs $id]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3694
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3695
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3696
    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3697
	catch {unset $v}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3698
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3699
    readrefs
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3700
    set refids [lsort -unique [concat $refids [array names idtags] \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3701
			[array names idheads] [array names idotherrefs]]]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3702
    foreach id $refids {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3703
	set v [listrefs $id]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3704
	if {![info exists ref($id)] || $ref($id) != $v} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3705
	    redrawtags $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3706
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3707
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3708
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3709
5394
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3710
proc vdiff {withparent} {
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3711
    global env rowmenuid selectedline lineid
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3712
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3713
    if {![info exists rowmenuid]} return
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3714
    set curid $rowmenuid
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3715
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3716
    if {$withparent} {
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3717
	set parents [exec $env(HG) --config ui.report_untrusted=false parents --rev $curid --template "{node}\n"]
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3718
	set firstparent [lindex [split $parents "\n"] 0]
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3719
	set otherid $firstparent
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3720
    } else {
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3721
	if {![info exists selectedline]} return
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3722
	set otherid $lineid($selectedline)
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3723
    }
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3724
    set range "$otherid:$curid"
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3725
    if {[catch {exec $env(HG) --config ui.report_untrusted=false vdiff -r $range} err]} {
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3726
        # Ignore errors, this is just visualization
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3727
    }
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3728
}
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3729
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3730
proc showtag {tag isnew} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3731
    global ctext cflist tagcontents tagids linknum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3732
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3733
    if {$isnew} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3734
	addtohistory [list showtag $tag 0]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3735
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3736
    $ctext conf -state normal
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3737
    $ctext delete 0.0 end
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3738
    set linknum 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3739
    if {[info exists tagcontents($tag)]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3740
	set text $tagcontents($tag)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3741
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3742
	set text "Tag: $tag\nId:  $tagids($tag)"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3743
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3744
    appendwithlinks $text
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3745
    $ctext conf -state disabled
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3746
    $cflist delete 0 end
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3747
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3748
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3749
proc doquit {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3750
    global stopped
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3751
    set stopped 100
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3752
    destroy .
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3753
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3754
5393
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  3755
proc getconfig {} {
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  3756
    global env
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  3757
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  3758
    set lines [exec $env(HG) debug-config]
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  3759
    regsub -all "\r\n" $lines "\n" config
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  3760
    set config {}
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  3761
    foreach line [split $lines "\n"] {
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  3762
	regsub "^(k|v)=" $line "" line
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  3763
	lappend config $line
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  3764
    }
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  3765
    return $config
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  3766
}
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  3767
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3768
# defaults...
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3769
set datemode 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3770
set boldnames 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3771
set diffopts "-U 5 -p"
4740
e1d1b22bab57 Use "--config ui.report_untrusted=false" for hg calls in hgk, fixes issue523.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4688
diff changeset
  3772
set wrcomcmd "\"\$HG\" --config ui.report_untrusted=false debug-diff-tree --stdin -p --pretty"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3773
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3774
set mainfont {Helvetica 9}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3775
set textfont {Courier 9}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3776
set findmergefiles 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3777
set gaudydiff 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3778
set maxgraphpct 50
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3779
set maxwidth 16
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3780
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3781
set colors {green red blue magenta darkgrey brown orange}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3782
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3783
catch {source ~/.gitk}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3784
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3785
set namefont $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3786
if {$boldnames} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3787
    lappend namefont bold
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3788
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3789
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3790
set revtreeargs {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3791
foreach arg $argv {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3792
    switch -regexp -- $arg {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3793
	"^$" { }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3794
	"^-b" { set boldnames 1 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3795
	"^-d" { set datemode 1 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3796
	default {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3797
	    lappend revtreeargs $arg
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3798
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3799
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3800
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3801
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3802
set history {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3803
set historyindex 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3804
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3805
set stopped 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3806
set redisplaying 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3807
set stuffsaved 0
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3808
set patchnum 0
5394
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3809
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3810
array set config [getconfig]
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3811
set hgvdiff $config(vdiff)
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3812
setcoords
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3813
makewindow
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3814
readrefs
5284
f8c36b215281 hgk: add repo root to window title
Steve Borho <steve@borho.org>
parents: 5143
diff changeset
  3815
set hgroot [exec $env(HG) root]
f8c36b215281 hgk: add repo root to window title
Steve Borho <steve@borho.org>
parents: 5143
diff changeset
  3816
wm title . "hgk $hgroot"
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3817
getcommits $revtreeargs