contrib/hgk
author Augie Fackler <raf@durin42.com>
Thu, 23 Jun 2016 20:45:37 -0400
changeset 29395 4c8026babe8c
parent 24604 ce8dd4fd2d5d
permissions -rwxr-xr-x
import-checker: ensure cffi is always a system module I've had reports that this is not always happening, so whitelist it the way we whitelist other problem cases.
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
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    18
if {[catch {package require Ttk}]} {
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    19
    # use a shim
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    20
    namespace eval ttk {
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    21
        proc style args {}
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    22
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    23
        proc entry args {
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    24
            eval [linsert $args 0 ::entry] -relief flat
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    25
        }
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    26
    }
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    27
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    28
    interp alias {} ttk::button {} button
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    29
    interp alias {} ttk::frame {} frame
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    30
    interp alias {} ttk::label {} label
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    31
    interp alias {} ttk::scrollbar {} scrollbar
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    32
    interp alias {} ttk::optionMenu {} tk_optionMenu
18805
6a0578d07024 hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents: 18804
diff changeset
    33
6a0578d07024 hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents: 18804
diff changeset
    34
    proc updatepalette {} {}
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    35
} else {
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    36
    proc ::ttk::optionMenu {w varName firstValue args} {
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    37
        upvar #0 $varName var
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    38
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    39
        if {![info exists var]} {
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    40
            set var $firstValue
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    41
        }
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    42
        ttk::menubutton $w -textvariable $varName -menu $w.menu \
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    43
                -direction flush
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    44
        menu $w.menu -tearoff 0
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    45
        $w.menu add radiobutton -label $firstValue -variable $varName
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    46
        foreach i $args {
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    47
            $w.menu add radiobutton -label $i -variable $varName
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    48
        }
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    49
        return $w.menu
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    50
    }
18805
6a0578d07024 hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents: 18804
diff changeset
    51
    proc updatepalette {} {
6a0578d07024 hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents: 18804
diff changeset
    52
        catch {
6a0578d07024 hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents: 18804
diff changeset
    53
            tk_setPalette background [ttk::style lookup client -background]
6a0578d07024 hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents: 18804
diff changeset
    54
        }
6a0578d07024 hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents: 18804
diff changeset
    55
    }
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    56
}
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    57
4969
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    58
if {[tk windowingsystem] eq "win32"} {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    59
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    60
ttk::style theme use xpnative
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
    61
4969
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    62
set mw_classes [list Text Listbox Table TreeCtrl]
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    63
   foreach class $mw_classes { bind $class <MouseWheel> {} }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    64
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    65
set in_mousewheel 0
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    66
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    67
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
    68
    global in_mousewheel
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    69
    if { $in_mousewheel != 0 } { return }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    70
    # Set event to check based on call
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    71
    set evt "<[expr {$shifted?{Shift-}:{}}]MouseWheel>"
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    72
    # 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
    73
    if {[bind [winfo class $wFired] $evt] ne ""} { return }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    74
    # obtain the window the mouse is over
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    75
    set w [winfo containing $X $Y]
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    76
    # 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
    77
    if {![winfo exists $w]} { catch {set w [focus]} }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    78
    if {[winfo exists $w]} {
5143
d4fa6bafc43a Remove trailing spaces, fix indentation
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4969
diff changeset
    79
4969
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    80
        if {[bind $w $evt] ne ""} {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    81
            # 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
    82
            # 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
    83
            catch {focus} old
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    84
            if {$w ne $old} { focus $w }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    85
            set in_mousewheel 1
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    86
            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
    87
            set in_mousewheel 0
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    88
            if {$w ne $old} { focus $old }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    89
            return
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    90
        }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    91
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    92
        # aqua and x11/win32 have different delta handling
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    93
        if {[tk windowingsystem] ne "aqua"} {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    94
            set delta [expr {- ($D / 30)}]
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    95
        } else {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    96
            set delta [expr {- ($D)}]
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    97
        }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    98
        # scrollbars have different call conventions
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
    99
        if {[string match "*Scrollbar" [winfo class $w]]} {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   100
            catch {tk::ScrollByUnits $w \
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   101
                       [string index [$w cget -orient] 0] $delta}
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   102
        } else {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   103
            set cmd [list $w [expr {$shifted ? "xview" : "yview"}] \
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   104
                         scroll $delta units]
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   105
            # 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
   106
            # embedded widgets in a canvas)
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   107
            while {[catch $cmd] && [winfo toplevel $w] ne $w} {
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   108
                set w [winfo parent $w]
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   109
            }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   110
        }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   111
    }
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   112
}
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   113
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   114
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
   115
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   116
# end of win32 section
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   117
} else {
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   118
18561
7365d031d457 hgk: support the old way of getting the current Ttk theme (issue3808)
Andrew Shadura <bugzilla@tut.by>
parents: 17960
diff changeset
   119
if {[catch {
7365d031d457 hgk: support the old way of getting the current Ttk theme (issue3808)
Andrew Shadura <bugzilla@tut.by>
parents: 17960
diff changeset
   120
    set theme [ttk::style theme use]
7365d031d457 hgk: support the old way of getting the current Ttk theme (issue3808)
Andrew Shadura <bugzilla@tut.by>
parents: 17960
diff changeset
   121
}]} {
7365d031d457 hgk: support the old way of getting the current Ttk theme (issue3808)
Andrew Shadura <bugzilla@tut.by>
parents: 17960
diff changeset
   122
    set theme $::ttk::currentTheme
7365d031d457 hgk: support the old way of getting the current Ttk theme (issue3808)
Andrew Shadura <bugzilla@tut.by>
parents: 17960
diff changeset
   123
}
7365d031d457 hgk: support the old way of getting the current Ttk theme (issue3808)
Andrew Shadura <bugzilla@tut.by>
parents: 17960
diff changeset
   124
if {$theme eq "default"} {
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   125
    ttk::style theme use clam
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   126
}
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   127
5143
d4fa6bafc43a Remove trailing spaces, fix indentation
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4969
diff changeset
   128
}
4969
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   129
18805
6a0578d07024 hgk: update backgroud colour when Ttk is available
Andrew Shadura <bugzilla@tut.by>
parents: 18804
diff changeset
   130
updatepalette
4969
b43db44cd047 hgk: enable mouse wheel under Windows.
Patrick Mezard <pmezard@gmail.com>
parents: 4968
diff changeset
   131
5392
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
   132
# Unify right mouse button handling.
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
   133
# 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
   134
if {[tk windowingsystem] eq "aqua"} {
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
   135
    event add <<B3>> <Control-ButtonPress-1>
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
   136
    event add <<B3>> <Button-2>
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
   137
} else {
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
   138
    event add <<B3>> <Button-3>
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
   139
}
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
   140
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   141
proc gitdir {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   142
    global env
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   143
    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
   144
	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
   145
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   146
	return ".hg"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   147
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   148
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   149
18804
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   150
proc popupify {w} {
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   151
    wm resizable $w 0 0
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   152
    wm withdraw $w
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   153
    update
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   154
    set x [expr {([winfo screenwidth .]-[winfo reqwidth $w])/2}]
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   155
    set y [expr {([winfo screenheight .]-[winfo reqheight $w])/2}]
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   156
    wm geometry  $w +$x+$y
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   157
    wm transient $w .
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   158
    wm deiconify $w
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   159
    wm resizable $w 1 1
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   160
}
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   161
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   162
proc getcommits {rargs} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   163
    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
   164
    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
   165
    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
   166
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   167
    # 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
   168
    set gitdir [gitdir]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   169
    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
   170
	error_popup "Cannot find the git directory \"$gitdir\"."
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   171
	exit 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   172
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   173
    set commits {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   174
    set phase getcommits
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   175
    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
   176
    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
   177
    set ncmupdate 1
3093
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   178
    set limit 0
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   179
    set revargs {}
24512
e5c5ddc3b172 hgk: pass --hidden switch to hg subprocesses when needed
Andrew Shadura <andrew@shadura.me>
parents: 22631
diff changeset
   180
    set showhidden no
3093
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   181
    for {set i 0} {$i < [llength $rargs]} {incr i} {
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   182
	set opt [lindex $rargs $i]
24512
e5c5ddc3b172 hgk: pass --hidden switch to hg subprocesses when needed
Andrew Shadura <andrew@shadura.me>
parents: 22631
diff changeset
   183
	switch -- $opt --limit {
3093
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   184
	    incr i
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   185
	    set limit [lindex $rargs $i]
24512
e5c5ddc3b172 hgk: pass --hidden switch to hg subprocesses when needed
Andrew Shadura <andrew@shadura.me>
parents: 22631
diff changeset
   186
	} --hidden {
e5c5ddc3b172 hgk: pass --hidden switch to hg subprocesses when needed
Andrew Shadura <andrew@shadura.me>
parents: 22631
diff changeset
   187
	    set showhidden yes
e5c5ddc3b172 hgk: pass --hidden switch to hg subprocesses when needed
Andrew Shadura <andrew@shadura.me>
parents: 22631
diff changeset
   188
	} default {
3093
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   189
	    lappend revargs $opt
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   190
	}
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   191
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   192
    if [catch {
24515
c1fe7111b6bb hgk: remove no longer needed debug-rev-parse command
Andrew Shadura <andrew@shadura.me>
parents: 24514
diff changeset
   193
	set parse_args [concat tip $revargs]
c1fe7111b6bb hgk: remove no longer needed debug-rev-parse command
Andrew Shadura <andrew@shadura.me>
parents: 24514
diff changeset
   194
	set parse_temp [eval exec {$env(HG)} --config ui.report_untrusted=false log --template '{node}\n' $parse_args]
3940
a33ddd20105c hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents: 3093
diff changeset
   195
	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
   196
	set parsed_args [split $parse_temp "\n"]
3093
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   197
    } err] {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   198
	# 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
   199
	if {$rargs == {}} {
3093
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   200
	    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
   201
	}
3093
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   202
	set parsed_args $revargs
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   203
    }
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   204
    if {$limit > 0} {
edefbb3a3b08 hgk: add --limit, and revranges
Brendan Cully <brendan@kublai.com>
parents: 3092
diff changeset
   205
	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
   206
    }
24512
e5c5ddc3b172 hgk: pass --hidden switch to hg subprocesses when needed
Andrew Shadura <andrew@shadura.me>
parents: 22631
diff changeset
   207
    if {$showhidden} {
e5c5ddc3b172 hgk: pass --hidden switch to hg subprocesses when needed
Andrew Shadura <andrew@shadura.me>
parents: 22631
diff changeset
   208
	append parsed_args --hidden
e5c5ddc3b172 hgk: pass --hidden switch to hg subprocesses when needed
Andrew Shadura <andrew@shadura.me>
parents: 22631
diff changeset
   209
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   210
    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
   211
	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
   212
    } err] {
1278
6a0d373d3126 hgit -> hgk.py
mpm@selenic.com
parents: 1240
diff changeset
   213
	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
   214
	exit 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   215
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   216
    set leftover {}
20763
0132cbe30c41 hgk: ignore ctrl-z as EOF on windows
Andrew Shadura <andrew@shadura.me>
parents: 20154
diff changeset
   217
    fconfigure $commfd -blocking 0 -translation lf -eofchar {}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   218
    fileevent $commfd readable [list getcommitlines $commfd]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   219
    $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
   220
    $canv create text 3 3 -anchor nw -text "Reading commits..." \
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   221
	-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
   222
    . config -cursor watch
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   223
    settextcursor watch
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   224
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   225
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   226
proc getcommitlines {commfd}  {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   227
    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
   228
    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
   229
    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
   230
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   231
    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
   232
    if {$stuff == {}} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   233
	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
   234
	# 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
   235
	fconfigure $commfd -blocking 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   236
	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
   237
	    after idle finishcommits
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   238
	    return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   239
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   240
	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
   241
	    set err \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   242
{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
   243
(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
   244
to allow selection of commits to be displayed.)}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   245
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   246
	    set err "Error reading commits: $err"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   247
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   248
	error_popup $err
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   249
	exit 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   250
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   251
    set start 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   252
    while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   253
	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
   254
	if {$i < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   255
	    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
   256
	    return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   257
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   258
	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
   259
	if {$start == 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   260
	    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
   261
	    set leftover {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   262
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   263
	set start [expr {$i + 1}]
3940
a33ddd20105c hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents: 3093
diff changeset
   264
	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
   265
	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
   266
	set ok 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   267
	if {$j >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   268
	    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
   269
	    set ok 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   270
	    foreach id $ids {
3059
3dab573a4330 hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents: 2297
diff changeset
   271
		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
   272
		    set ok 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   273
		    break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   274
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   275
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   276
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   277
	if {!$ok} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   278
	    set shortcmit $cmit
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   279
	    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
   280
		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
   281
	    }
1278
6a0d373d3126 hgit -> hgk.py
mpm@selenic.com
parents: 1240
diff changeset
   282
	    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
   283
	    exit 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   284
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   285
	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
   286
	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
   287
	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
   288
	lappend commits $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   289
	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
   290
	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
   291
	drawcommit $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   292
	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
   293
	    doupdate 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   294
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   295
	while {$redisplaying} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   296
	    set redisplaying 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   297
	    if {$stopped == 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   298
		set stopped 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   299
		set phase "getcommits"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   300
		foreach id $commits {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   301
		    drawcommit $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   302
		    if {$stopped} break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   303
		    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
   304
			doupdate 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   305
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   306
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   307
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   308
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   309
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   310
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   311
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   312
proc doupdate {reading} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   313
    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
   314
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   315
    if {$reading} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   316
	fileevent $commfd readable {}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   317
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   318
    update
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   319
    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
   320
    if {$numcommits < 100} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   321
	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
   322
    } elseif {$numcommits < 10000} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   323
	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
   324
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   325
	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
   326
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   327
    if {$reading} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   328
	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
   329
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   330
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   331
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   332
proc readcommit {id} {
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
   333
    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
   334
    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
   335
    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
   336
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   337
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   338
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
   339
    global commitinfo children nchildren parents nparents cdate ncleft
24513
b5a0b2374eb6 hgk: display obsolete changesets in darkgrey
Andrew Shadura <andrew@shadura.me>
parents: 24512
diff changeset
   340
    global firstparents obsolete
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   341
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   342
    set inhdr 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   343
    set comment {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   344
    set headline {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   345
    set auname {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   346
    set audate {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   347
    set comname {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   348
    set comdate {}
3092
d0fcce3728d1 hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents: 3059
diff changeset
   349
    set rev {}
5859
e0f86c1e3ae5 hgk: display branch name in diff header
Patrick Mezard <pmezard@gmail.com>
parents: 5662
diff changeset
   350
    set branch {}
13461
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   351
    set bookmark {}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   352
    if {![info exists nchildren($id)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   353
	set children($id) {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   354
	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
   355
	set ncleft($id) 0
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   356
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   357
    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
   358
    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
   359
    foreach p $olds {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   360
	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
   361
	    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
   362
	    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
   363
	    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
   364
	} 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
   365
	    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
   366
	    incr nchildren($p)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   367
	    incr ncleft($p)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   368
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   369
    }
3940
a33ddd20105c hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents: 3093
diff changeset
   370
    regsub -all "\r\n" $contents "\n" contents
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   371
    foreach line [split $contents "\n"] {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   372
	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
   373
	    set line [split $line]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   374
	    if {$line == {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   375
		set inhdr 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   376
	    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   377
		set tag [lindex $line 0]
24531
18ee81b37928 hgk: use switch instead of a less efficient if/elseif/if
Andrew Shadura <andrew@shadura.me>
parents: 24530
diff changeset
   378
		switch -- $tag "author" {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   379
		    set x [expr {[llength $line] - 2}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   380
		    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
   381
		    set auname [join [lrange $line 1 [expr {$x - 1}]]]
24531
18ee81b37928 hgk: use switch instead of a less efficient if/elseif/if
Andrew Shadura <andrew@shadura.me>
parents: 24530
diff changeset
   382
		} "committer" {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   383
		    set x [expr {[llength $line] - 2}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   384
		    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
   385
		    set comname [join [lrange $line 1 [expr {$x - 1}]]]
24531
18ee81b37928 hgk: use switch instead of a less efficient if/elseif/if
Andrew Shadura <andrew@shadura.me>
parents: 24530
diff changeset
   386
		} "revision" {
3092
d0fcce3728d1 hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents: 3059
diff changeset
   387
		    set rev [lindex $line 1]
24531
18ee81b37928 hgk: use switch instead of a less efficient if/elseif/if
Andrew Shadura <andrew@shadura.me>
parents: 24530
diff changeset
   388
		} "branch" {
5859
e0f86c1e3ae5 hgk: display branch name in diff header
Patrick Mezard <pmezard@gmail.com>
parents: 5662
diff changeset
   389
		    set branch [join [lrange $line 1 end]]
24531
18ee81b37928 hgk: use switch instead of a less efficient if/elseif/if
Andrew Shadura <andrew@shadura.me>
parents: 24530
diff changeset
   390
		} "bookmark" {
13461
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   391
		    set bookmark [join [lrange $line 1 end]]
24531
18ee81b37928 hgk: use switch instead of a less efficient if/elseif/if
Andrew Shadura <andrew@shadura.me>
parents: 24530
diff changeset
   392
		} "obsolete" {
24513
b5a0b2374eb6 hgk: display obsolete changesets in darkgrey
Andrew Shadura <andrew@shadura.me>
parents: 24512
diff changeset
   393
		    set obsolete($id) ""
24531
18ee81b37928 hgk: use switch instead of a less efficient if/elseif/if
Andrew Shadura <andrew@shadura.me>
parents: 24530
diff changeset
   394
		} "phase" {
24529
14873da80bc1 hgk: show secret changesets differently (shape and label)
Andrew Shadura <andrew@shadura.me>
parents: 24515
diff changeset
   395
		    set phase [lindex $line 1 end]
24531
18ee81b37928 hgk: use switch instead of a less efficient if/elseif/if
Andrew Shadura <andrew@shadura.me>
parents: 24530
diff changeset
   396
		}
267
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
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   399
	    if {$comment == {}} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   400
		set headline [string trim $line]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   401
	    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   402
		append comment "\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   403
	    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   404
	    if {!$listed} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   405
		# 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
   406
		# 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
   407
		append comment "    "
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   408
	    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   409
	    append comment $line
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   410
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   411
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   412
    if {$audate != {}} {
18803
82289176717d hgk: don't use fixed format for dates
Andrew Shadura <bugzilla@tut.by>
parents: 18802
diff changeset
   413
	set audate [clock format $audate]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   414
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   415
    if {$comdate != {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   416
	set cdate($id) $comdate
18803
82289176717d hgk: don't use fixed format for dates
Andrew Shadura <bugzilla@tut.by>
parents: 18802
diff changeset
   417
	set comdate [clock format $comdate]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   418
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   419
    set commitinfo($id) [list $headline $auname $audate \
24529
14873da80bc1 hgk: show secret changesets differently (shape and label)
Andrew Shadura <andrew@shadura.me>
parents: 24515
diff changeset
   420
			     $comname $comdate $comment $rev $branch $bookmark $phase]
7776
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   421
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   422
    if {[info exists firstparents]} {
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   423
        set i [lsearch $firstparents $id]
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   424
        if {$i != -1} {
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   425
            # remove the parent from firstparents, possible building
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   426
            # an empty list
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   427
            set firstparents [concat \
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   428
                                  [lrange $firstparents 0 [expr $i - 1]] \
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   429
                                  [lrange $firstparents [expr $i + 1] end]]
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   430
            if {$firstparents eq {}} {
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   431
                # we have found all parents of the first changeset
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   432
                # which means that we can safely select the first line
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   433
                after idle {
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   434
                    selectline 0 0
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   435
                }
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   436
            }
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   437
        }
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   438
    } else {
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   439
        # this is the first changeset, save the parents
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   440
        set firstparents $olds
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   441
        if {$firstparents eq {}} {
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   442
            # a repository with a single changeset
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   443
            after idle {
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   444
                selectline 0 0
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   445
            }
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   446
        }
34ff1a1b5dd7 hgk: select first changeset at startup (issue1382)
Martin Geisler <mg@daimi.au.dk>
parents: 7747
diff changeset
   447
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   448
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   449
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   450
proc readrefs {} {
13461
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   451
    global bookmarkcurrent bookmarkids tagids idtags idbookmarks headids idheads tagcontents env curid
6210
942287cb1f57 Removed trailing spaces from everything except test output
Thomas Arendsen Hein <thomas@intevation.de>
parents: 5859
diff changeset
   452
6322
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   453
    set status [catch {exec $env(HG) --config ui.report_untrusted=false id} curid]
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   454
    if { $status != 0 } {
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   455
        puts $::errorInfo
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   456
        if { ![string equal $::errorCode NONE] } {
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   457
            exit 2
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   458
        }
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   459
    }
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   460
    regexp -- {[[:xdigit:]]+} $curid curid
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   461
6322
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   462
    set status [catch {exec $env(HG) --config ui.report_untrusted=false tags} tags]
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   463
    if { $status != 0 } {
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   464
        puts $::errorInfo
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   465
        if { ![string equal $::errorCode NONE] } {
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   466
            exit 2
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   467
        }
108636b9b981 hgk: don't exit if mercurial commands only print warnings
Dennis Schoen <ds@1d10t.de>
parents: 6210
diff changeset
   468
    }
18808
962844e8dd8e hgk: simplify tags parser
Andrew Shadura <bugzilla@tut.by>
parents: 18806
diff changeset
   469
20154
970394b6bd97 hgk: fix tag list parser (issue4101)
Andrew Shadura <andrew@shadura.me>
parents: 19023
diff changeset
   470
    foreach {- tag rev id} [regexp -inline -all -line {^(.+\S)\s+(\d+):(\S+)} $tags] {
18808
962844e8dd8e hgk: simplify tags parser
Andrew Shadura <bugzilla@tut.by>
parents: 18806
diff changeset
   471
        # we use foreach as Tcl8.4 doesn't support lassign
20154
970394b6bd97 hgk: fix tag list parser (issue4101)
Andrew Shadura <andrew@shadura.me>
parents: 19023
diff changeset
   472
        lappend tagids($tag) $id
970394b6bd97 hgk: fix tag list parser (issue4101)
Andrew Shadura <andrew@shadura.me>
parents: 19023
diff changeset
   473
        lappend idtags($id) $tag
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   474
    }
7039
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   475
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   476
    set status [catch {exec $env(HG) --config ui.report_untrusted=false heads} heads]
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   477
    if { $status != 0 } {
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   478
        puts $::errorInfo
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   479
        if { ![string equal $::errorCode NONE] } {
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   480
            exit 2
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   481
        }
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   482
    }
18809
3131c9da8bf6 hgk: remove regsub, split on \r instead
Andrew Shadura <bugzilla@tut.by>
parents: 18808
diff changeset
   483
3131c9da8bf6 hgk: remove regsub, split on \r instead
Andrew Shadura <bugzilla@tut.by>
parents: 18808
diff changeset
   484
    set lines [split $heads \r\n]
7039
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   485
    foreach f $lines {
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   486
        set match ""
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   487
        regexp {changeset:\s+(\S+):(\S+)$} $f match id sha
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   488
        if {$match != ""} {
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   489
        lappend idheads($sha) $id
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   490
        }
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   491
    }
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
   492
13461
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   493
    set status [catch {exec $env(HG) --config ui.report_untrusted=false bookmarks} bookmarks]
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   494
    if { $status != 0 } {
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   495
        puts $::errorInfo
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   496
        if { ![string equal $::errorCode NONE] } {
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   497
            exit 2
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   498
        }
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   499
    }
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   500
    set lines [split $bookmarks "\n"]
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   501
    set bookmarkcurrent 0
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   502
    foreach f $lines {
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   503
	regexp {(\S+)$} $f full
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   504
	regsub {\s+(\S+)$} $f "" direct
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   505
	set sha [split $full ':']
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   506
	set bookmark [lindex $sha 1]
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   507
	set current [string first " * " $direct)]
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   508
	regsub {^\s(\*|\s)\s} $direct "" direct
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   509
	lappend bookmarkids($direct) $bookmark
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   510
	lappend idbookmarks($bookmark) $direct
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   511
	if {$current >= 0} {
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   512
		set bookmarkcurrent $direct
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   513
	}
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
   514
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   515
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   516
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   517
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
   518
    global otherrefids idotherrefs
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   519
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   520
    set git [gitdir]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   521
    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
   522
    foreach f $files {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   523
	catch {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   524
	    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
   525
	    set line [read $fd 40]
3059
3dab573a4330 hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents: 2297
diff changeset
   526
	    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
   527
		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
   528
		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
   529
		lappend idotherrefs($id) $name
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   530
	    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   531
	    close $fd
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   532
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   533
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   534
    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
   535
    foreach d $dirs {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   536
	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
   537
	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
   538
	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
   539
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   540
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   541
4968
713426631adf hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents: 4741
diff changeset
   542
proc allcansmousewheel {delta} {
713426631adf hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents: 4741
diff changeset
   543
    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
   544
    allcanvs yview scroll $delta units
713426631adf hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents: 4741
diff changeset
   545
}
713426631adf hgk: enable mouse wheel on MouseWheel events.
Patrick Mezard <pmezard@gmail.com>
parents: 4741
diff changeset
   546
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   547
proc error_popup msg {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   548
    set w .error
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   549
    toplevel $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   550
    wm transient $w .
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   551
    message $w.m -text $msg -justify center -aspect 400
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   552
    pack $w.m -side top -fill x -padx 20 -pady 20
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   553
    ttk::button $w.ok -text OK -command "destroy $w"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   554
    pack $w.ok -side bottom -fill x
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   555
    bind $w <Visibility> "grab $w; focus $w"
18804
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   556
    popupify $w
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   557
    tkwait window $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   558
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   559
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   560
proc makewindow {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   561
    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
   562
    global findtype findtypemenu findloc findstring fstring geometry
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   563
    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
   564
    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
   565
    global rowctxmenu gaudydiff mergemax
7746
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   566
    global hgvdiff bgcolor fgcolor diffremcolor diffaddcolor diffmerge1color
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   567
    global diffmerge2color hunksepcolor
12634
43f42de733d0 hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents: 9989
diff changeset
   568
    global posx posy
43f42de733d0 hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents: 9989
diff changeset
   569
43f42de733d0 hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents: 9989
diff changeset
   570
    if {[info exists posx]} {
43f42de733d0 hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents: 9989
diff changeset
   571
        wm geometry . +$posx+$posy
43f42de733d0 hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents: 9989
diff changeset
   572
    }
19023
86531a7038ed codingstyle: remove trailing spaces in various text files
Mads Kiilerich <madski@unity3d.com>
parents: 18809
diff changeset
   573
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   574
    menu .bar
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   575
    .bar add cascade -label "File" -menu .bar.file
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   576
    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
   577
    .bar.file add command -label "Reread references" -command rereadrefs
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   578
    .bar.file add command -label "Quit" -command doquit
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   579
    menu .bar.help
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   580
    .bar add cascade -label "Help" -menu .bar.help
13380
d11405848abd hgk: gitk->hgk in About... menu
Javi Merino <cibervicho@gmail.com>
parents: 12634
diff changeset
   581
    .bar.help add command -label "About hgk" -command about
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   582
    . configure -menu .bar
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   583
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   584
    if {![info exists geometry(canv1)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   585
	set geometry(canv1) [expr 45 * $charspc]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   586
	set geometry(canv2) [expr 30 * $charspc]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   587
	set geometry(canv3) [expr 15 * $charspc]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   588
	set geometry(canvh) [expr 25 * $linespc + 4]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   589
	set geometry(ctextw) 80
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   590
	set geometry(ctexth) 30
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   591
	set geometry(cflistw) 30
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   592
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   593
    panedwindow .ctop -orient vertical
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   594
    if {[info exists geometry(width)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   595
	.ctop conf -width $geometry(width) -height $geometry(height)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   596
	set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   597
	set geometry(ctexth) [expr {($texth - 8) /
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   598
				    [font metrics $textfont -linespace]}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   599
    }
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   600
    ttk::frame .ctop.top
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   601
    ttk::frame .ctop.top.bar
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   602
    pack .ctop.top.bar -side bottom -fill x
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   603
    set cscroll .ctop.top.csb
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   604
    ttk::scrollbar $cscroll -command {allcanvs yview}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   605
    pack $cscroll -side right -fill y
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   606
    panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   607
    pack .ctop.top.clist -side top -fill both -expand 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   608
    .ctop add .ctop.top
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   609
    set canv .ctop.top.clist.canv
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   610
    canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
7738
db366ec8d0a4 hgk: Add background colour setting
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7039
diff changeset
   611
	-bg $bgcolor -bd 0 \
17960
d0d99c8bdf51 hgk: specify some colours explicitly in hex
Andrew Shadura <bugzilla@tut.by>
parents: 17958
diff changeset
   612
	-yscrollincr $linespc -yscrollcommand "$cscroll set" -selectbackground "#c0c0c0"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   613
    .ctop.top.clist add $canv
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   614
    set canv2 .ctop.top.clist.canv2
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   615
    canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
17960
d0d99c8bdf51 hgk: specify some colours explicitly in hex
Andrew Shadura <bugzilla@tut.by>
parents: 17958
diff changeset
   616
	-bg $bgcolor -bd 0 -yscrollincr $linespc -selectbackground "#c0c0c0"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   617
    .ctop.top.clist add $canv2
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   618
    set canv3 .ctop.top.clist.canv3
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   619
    canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
17960
d0d99c8bdf51 hgk: specify some colours explicitly in hex
Andrew Shadura <bugzilla@tut.by>
parents: 17958
diff changeset
   620
	-bg $bgcolor -bd 0 -yscrollincr $linespc -selectbackground "#c0c0c0"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   621
    .ctop.top.clist add $canv3
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   622
    bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   623
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   624
    set sha1entry .ctop.top.bar.sha1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   625
    set entries $sha1entry
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   626
    set sha1but .ctop.top.bar.sha1label
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   627
    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   628
	-command gotocommit -width 8
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   629
    $sha1but conf -disabledforeground [$sha1but cget -foreground]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   630
    pack .ctop.top.bar.sha1label -side left
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   631
    ttk::entry $sha1entry -width 40 -font $textfont -textvariable sha1string
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   632
    trace add variable sha1string write sha1change
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   633
    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
   634
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   635
    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
   636
	#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
   637
	#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
   638
	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
   639
	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
   640
	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
   641
	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
   642
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   643
    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
   644
	#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
   645
	#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
   646
	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
   647
	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
   648
	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
   649
	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
   650
    }
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   651
    ttk::button .ctop.top.bar.leftbut -image bm-left -command goback \
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   652
	-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
   653
    pack .ctop.top.bar.leftbut -side left -fill y
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   654
    ttk::button .ctop.top.bar.rightbut -image bm-right -command goforw \
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   655
	-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
   656
    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
   657
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   658
    ttk::button .ctop.top.bar.findbut -text "Find" -command dofind
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   659
    pack .ctop.top.bar.findbut -side left
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   660
    set findstring {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   661
    set fstring .ctop.top.bar.findstring
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   662
    lappend entries $fstring
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   663
    ttk::entry $fstring -width 30 -font $textfont -textvariable findstring
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   664
    pack $fstring -side left -expand 1 -fill x
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   665
    set findtype Exact
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   666
    set findtypemenu [ttk::optionMenu .ctop.top.bar.findtype \
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   667
			  findtype Exact IgnCase Regexp]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   668
    set findloc "All fields"
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   669
    ttk::optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
18801
c84cc0f3364a hgk: drop committer field from the UI
Andrew Shadura <bugzilla@tut.by>
parents: 18561
diff changeset
   670
	Comments Author Files Pickaxe
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   671
    pack .ctop.top.bar.findloc -side right
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   672
    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
   673
    # 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
   674
    trace add variable findloc write findlocchange
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   675
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   676
    panedwindow .ctop.cdet -orient horizontal
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   677
    .ctop add .ctop.cdet
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   678
    ttk::frame .ctop.cdet.left
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   679
    set ctext .ctop.cdet.left.ctext
7745
8bfe47e726fe hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7738
diff changeset
   680
    text $ctext -fg $fgcolor -bg $bgcolor -state disabled -font $textfont \
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   681
	-width $geometry(ctextw) -height $geometry(ctexth) \
1430
c91966c3bbf5 hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents: 1429
diff changeset
   682
	-yscrollcommand ".ctop.cdet.left.sb set" \
c91966c3bbf5 hgk: add horizontal scrollbar to patch window
TK Soh <teekaysoh@yahoo.com>
parents: 1429
diff changeset
   683
	-xscrollcommand ".ctop.cdet.left.hb set" -wrap none
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   684
    ttk::scrollbar .ctop.cdet.left.sb -command "$ctext yview"
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   685
    ttk::scrollbar .ctop.cdet.left.hb -orient horizontal -command "$ctext xview"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   686
    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
   687
    pack .ctop.cdet.left.hb -side bottom -fill x
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   688
    pack $ctext -side left -fill both -expand 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   689
    .ctop.cdet add .ctop.cdet.left
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   690
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   691
    $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
   692
    if {$gaudydiff} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   693
	$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
   694
	$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
   695
	$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
   696
    } else {
7746
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   697
	$ctext tag conf hunksep -fore $hunksepcolor
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   698
	$ctext tag conf d0 -fore $diffremcolor
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   699
	$ctext tag conf d1 -fore $diffaddcolor
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   700
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   701
	# The mX colours seem to be used in merge changesets, where m0
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   702
	# is first parent, m1 is second parent and so on. Git can have
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   703
	# several parents, Hg cannot, so I think the m2..mmax would be
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   704
	# unused.
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   705
	$ctext tag conf m0 -fore $diffmerge1color
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   706
	$ctext tag conf m1 -fore $diffmerge2color
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   707
	$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
   708
	$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
   709
	$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
   710
	$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
   711
	set mergemax 5
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   712
	$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
   713
	$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
   714
	$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
   715
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   716
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   717
    ttk::frame .ctop.cdet.right
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   718
    set cflist .ctop.cdet.right.cfiles
7745
8bfe47e726fe hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7738
diff changeset
   719
    listbox $cflist -fg $fgcolor -bg $bgcolor \
8bfe47e726fe hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7738
diff changeset
   720
        -selectmode extended -width $geometry(cflistw) \
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   721
	-yscrollcommand ".ctop.cdet.right.sb set"
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   722
    ttk::scrollbar .ctop.cdet.right.sb -command "$cflist yview"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   723
    pack .ctop.cdet.right.sb -side right -fill y
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   724
    pack $cflist -side left -fill both -expand 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   725
    .ctop.cdet add .ctop.cdet.right
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   726
    bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   727
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   728
    pack .ctop -side top -fill both -expand 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   729
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   730
    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
   731
    #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
   732
    bindall <MouseWheel> "allcansmousewheel %D"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   733
    bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   734
    bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   735
    bindall <2> "allcanvs scan mark 0 %y"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   736
    bindall <B2-Motion> "allcanvs scan dragto 0 %y"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   737
    bind . <Key-Up> "selnextline -1"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   738
    bind . <Key-Down> "selnextline 1"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   739
    bind . <Key-Prior> "allcanvs yview scroll -1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   740
    bind . <Key-Next> "allcanvs yview scroll 1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   741
    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   742
    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   743
    bindkey <Key-space> "$ctext yview scroll 1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   744
    bindkey p "selnextline -1"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   745
    bindkey n "selnextline 1"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   746
    bindkey b "$ctext yview scroll -1 pages"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   747
    bindkey d "$ctext yview scroll 18 units"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   748
    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
   749
    bindkey / {findnext 1}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   750
    bindkey <Key-Return> {findnext 0}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   751
    bindkey ? findprev
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   752
    bindkey f nextfile
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   753
    bind . <Control-q> doquit
1429
45bd7925dceb Add control-w key binding to quit hgk.
Eric Bloodworth <ergosys@gmail.com>
parents: 1361
diff changeset
   754
    bind . <Control-w> doquit
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   755
    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
   756
    bind . <Control-g> {findnext 0}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   757
    bind . <Control-r> findprev
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   758
    bind . <Control-equal> {incrfont 1}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   759
    bind . <Control-KP_Add> {incrfont 1}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   760
    bind . <Control-minus> {incrfont -1}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   761
    bind . <Control-KP_Subtract> {incrfont -1}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   762
    bind $cflist <<ListboxSelect>> listboxsel
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   763
    bind . <Destroy> {savestuff %W}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   764
    bind . <Button-1> "click %W"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   765
    bind $fstring <Key-Return> dofind
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   766
    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
   767
    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
   768
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   769
    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
   770
    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
   771
    set curtextcursor $textcursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   772
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   773
    set rowctxmenu .rowctxmenu
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   774
    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
   775
    $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
   776
	-command {diffvssel 0}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   777
    $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
   778
	-command {diffvssel 1}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   779
    $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
   780
    $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
   781
    $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
   782
    if { $hgvdiff ne "" } {
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
   783
	$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
   784
	    -command {vdiff 1}
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
   785
	$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
   786
	    -command {vdiff 0}
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
   787
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   788
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   789
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   790
# when we make a key binding for the toplevel, make sure
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   791
# 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
   792
# find string entry widget.
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   793
proc bindkey {ev script} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   794
    global entries
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   795
    bind . $ev $script
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   796
    set escript [bind Entry $ev]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   797
    if {$escript == {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   798
	set escript [bind Entry <Key>]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   799
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   800
    foreach e $entries {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   801
	bind $e $ev "$escript; break"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   802
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   803
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   804
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   805
# set the focus back to the toplevel for any click outside
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   806
# the entry widgets
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   807
proc click {w} {
20764
d9378bfa0af0 hgk: enable selected patch text on Windows
Andrew Shadura <andrew@shadura.me>
parents: 20763
diff changeset
   808
    global ctext entries
d9378bfa0af0 hgk: enable selected patch text on Windows
Andrew Shadura <andrew@shadura.me>
parents: 20763
diff changeset
   809
    foreach e [concat $entries $ctext] {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   810
	if {$w == $e} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   811
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   812
    focus .
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
proc savestuff {w} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   816
    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
   817
    global stuffsaved findmergefiles gaudydiff maxgraphpct
7745
8bfe47e726fe hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7738
diff changeset
   818
    global maxwidth authorcolors curidfont bgcolor fgcolor
7746
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   819
    global diffremcolor diffaddcolor hunksepcolor
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   820
    global diffmerge1color diffmerge2color
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   821
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   822
    if {$stuffsaved} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   823
    if {![winfo viewable .]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   824
    catch {
5506
be20a42f27a1 hgk: change config file from .gitk to .hgk
bdowning@lavos.net
parents: 5464
diff changeset
   825
	set f [open "~/.hgk-new" w]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   826
	puts $f [list set mainfont $mainfont]
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   827
	puts $f [list set curidfont $curidfont]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   828
	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
   829
	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
   830
	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
   831
	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
   832
	puts $f [list set maxwidth $maxwidth]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   833
	puts $f "set geometry(width) [winfo width .ctop]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   834
	puts $f "set geometry(height) [winfo height .ctop]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   835
	puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   836
	puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   837
	puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   838
	puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   839
	set wid [expr {([winfo width $ctext] - 8) \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   840
			   / [font measure $textfont "0"]}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   841
	puts $f "set geometry(ctextw) $wid"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   842
	set wid [expr {([winfo width $cflist] - 11) \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   843
			   / [font measure [$cflist cget -font] "0"]}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   844
	puts $f "set geometry(cflistw) $wid"
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   845
	puts $f "#"
12634
43f42de733d0 hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents: 9989
diff changeset
   846
	puts $f "# main window position:"
43f42de733d0 hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents: 9989
diff changeset
   847
	puts $f "set posx [winfo x .]"
43f42de733d0 hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents: 9989
diff changeset
   848
	puts $f "set posy [winfo y .]"
43f42de733d0 hgk: remember main window position
Eduard-Cristian Stefan <alexandrul.ct@gmail.com>
parents: 9989
diff changeset
   849
	puts $f "#"
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   850
	puts $f "# authorcolors format:"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   851
	puts $f "#"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   852
	puts $f "# zero or more sublists of"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   853
	puts $f "#"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   854
	puts $f "#    { regex color }"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   855
	puts $f "#"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   856
	puts $f "# followed by a list of colors"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   857
	puts $f "#"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   858
	puts $f "# If the commit author matches a regex in a sublist,"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   859
	puts $f "# the commit will be colored by that color"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   860
	puts $f "# otherwise the next unused entry from the list of colors"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   861
	puts $f "# will be assigned to this commit and also all other commits"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   862
	puts $f "# of the same author.  When the list of colors is exhausted,"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   863
	puts $f "# the last entry will be reused."
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   864
	puts $f "#"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   865
	puts $f "set authorcolors {$authorcolors}"
7747
5f7512f680cb hgk: added explanation to .hgk for background colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7746
diff changeset
   866
	puts $f "#"
5f7512f680cb hgk: added explanation to .hgk for background colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7746
diff changeset
   867
	puts $f "# The background color in the text windows"
7738
db366ec8d0a4 hgk: Add background colour setting
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7039
diff changeset
   868
	puts $f "set bgcolor $bgcolor"
7745
8bfe47e726fe hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7738
diff changeset
   869
	puts $f "#"
8bfe47e726fe hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7738
diff changeset
   870
	puts $f "# The text color used in the diff and file list view"
8bfe47e726fe hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7738
diff changeset
   871
	puts $f "set fgcolor $fgcolor"
7746
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   872
	puts $f "#"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   873
	puts $f "# Color to display + lines in diffs"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   874
	puts $f "set diffaddcolor $diffaddcolor"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   875
	puts $f "#"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   876
	puts $f "# Color to display - lines in diffs"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   877
	puts $f "set diffremcolor $diffremcolor"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   878
	puts $f "#"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   879
	puts $f "# Merge diffs: Color to signal lines from first parent"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   880
	puts $f "set diffmerge1color $diffmerge1color"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   881
	puts $f "#"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   882
	puts $f "# Merge diffs: Color to signal lines from second parent"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   883
	puts $f "set diffmerge2color $diffmerge2color"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   884
	puts $f "#"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   885
	puts $f "# Hunkseparator (@@ -lineno,lines +lineno,lines @@) color"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
   886
	puts $f "set hunksepcolor $hunksepcolor"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   887
	close $f
5506
be20a42f27a1 hgk: change config file from .gitk to .hgk
bdowning@lavos.net
parents: 5464
diff changeset
   888
	file rename -force "~/.hgk-new" "~/.hgk"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   889
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   890
    set stuffsaved 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   891
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   892
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   893
proc resizeclistpanes {win w} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   894
    global oldwidth
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   895
    if [info exists oldwidth($win)] {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   896
	set s0 [$win sash coord 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   897
	set s1 [$win sash coord 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   898
	if {$w < 60} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   899
	    set sash0 [expr {int($w/2 - 2)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   900
	    set sash1 [expr {int($w*5/6 - 2)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   901
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   902
	    set factor [expr {1.0 * $w / $oldwidth($win)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   903
	    set sash0 [expr {int($factor * [lindex $s0 0])}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   904
	    set sash1 [expr {int($factor * [lindex $s1 0])}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   905
	    if {$sash0 < 30} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   906
		set sash0 30
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   907
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   908
	    if {$sash1 < $sash0 + 20} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   909
		set sash1 [expr $sash0 + 20]
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
	    if {$sash1 > $w - 10} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   912
		set sash1 [expr $w - 10]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   913
		if {$sash0 > $sash1 - 20} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   914
		    set sash0 [expr $sash1 - 20]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   915
		}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   916
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   917
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   918
	$win sash place 0 $sash0 [lindex $s0 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   919
	$win sash place 1 $sash1 [lindex $s1 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   920
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   921
    set oldwidth($win) $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   922
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   923
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   924
proc resizecdetpanes {win w} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   925
    global oldwidth
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   926
    if [info exists oldwidth($win)] {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   927
	set s0 [$win sash coord 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   928
	if {$w < 60} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   929
	    set sash0 [expr {int($w*3/4 - 2)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   930
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   931
	    set factor [expr {1.0 * $w / $oldwidth($win)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   932
	    set sash0 [expr {int($factor * [lindex $s0 0])}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   933
	    if {$sash0 < 45} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   934
		set sash0 45
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   935
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   936
	    if {$sash0 > $w - 15} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   937
		set sash0 [expr $w - 15]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   938
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   939
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   940
	$win sash place 0 $sash0 [lindex $s0 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   941
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   942
    set oldwidth($win) $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   943
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   944
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   945
proc allcanvs args {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   946
    global canv canv2 canv3
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   947
    eval $canv $args
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   948
    eval $canv2 $args
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   949
    eval $canv3 $args
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   950
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   951
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   952
proc bindall {event action} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   953
    global canv canv2 canv3
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   954
    bind $canv $event $action
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   955
    bind $canv2 $event $action
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   956
    bind $canv3 $event $action
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   957
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   958
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   959
proc about {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   960
    set w .about
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   961
    if {[winfo exists $w]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   962
	raise $w
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   963
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   964
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   965
    toplevel $w
13380
d11405848abd hgk: gitk->hgk in About... menu
Javi Merino <cibervicho@gmail.com>
parents: 12634
diff changeset
   966
    wm title $w "About hgk"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   967
    message $w.m -text {
13380
d11405848abd hgk: gitk->hgk in About... menu
Javi Merino <cibervicho@gmail.com>
parents: 12634
diff changeset
   968
Hgk version 1.2
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   969
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   970
Copyright © 2005 Paul Mackerras
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   971
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
   972
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
   973
	    -justify center -aspect 400
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   974
    pack $w.m -side top -fill x -padx 20 -pady 20
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
   975
    ttk::button $w.ok -text Close -command "destroy $w"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   976
    pack $w.ok -side bottom
18804
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
   977
    popupify $w
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   978
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
   979
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   980
set aunextcolor 0
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   981
proc assignauthorcolor {name} {
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   982
    global authorcolors aucolormap aunextcolor
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   983
    if [info exists aucolormap($name)] return
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   984
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   985
    set randomcolors {black}
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   986
    for {set i 0} {$i < [llength $authorcolors]} {incr i} {
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   987
	set col [lindex $authorcolors $i]
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   988
	if {[llength $col] > 1} {
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   989
	    set re [lindex $col 0]
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   990
	    set c [lindex $col 1]
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   991
	    if {[regexp -- $re $name]} {
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   992
		set aucolormap($name) $c
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   993
		return
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   994
	    }
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   995
	} else {
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   996
	    set randomcolors [lrange $authorcolors $i end]
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   997
	    break
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   998
	}
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
   999
    }
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1000
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1001
    set ncolors [llength $randomcolors]
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1002
    set c [lindex $randomcolors $aunextcolor]
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1003
    if {[incr aunextcolor] >= $ncolors} {
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1004
	incr aunextcolor -1
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1005
    }
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1006
    set aucolormap($name) $c
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1007
}
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1008
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1009
proc assigncolor {id} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1010
    global commitinfo colormap commcolors colors nextcolor
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1011
    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
  1012
    global cornercrossings crossings
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1013
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1014
    if [info exists colormap($id)] return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1015
    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
  1016
    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
  1017
	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
  1018
	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
  1019
	    && $nparents($child) == 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1020
	    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
  1021
	    return
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1022
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1023
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1024
    set badcolors {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1025
    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
  1026
	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
  1027
	    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
  1028
		&& [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
  1029
		lappend badcolors $colormap($x)
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1030
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1031
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1032
	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
  1033
	    set badcolors {}
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
    set origbad $badcolors
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1037
    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
  1038
	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
  1039
	    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
  1040
		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
  1041
		    && [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
  1042
		    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
  1043
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1044
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1045
	    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
  1046
		set badcolors $origbad
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1047
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1048
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1049
	set origbad $badcolors
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
    if {[llength $badcolors] < $ncolors - 1} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1052
	foreach child $children($id) {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1053
	    if {[info exists colormap($child)]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1054
		&& [lsearch -exact $badcolors $colormap($child)] < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1055
		lappend badcolors $colormap($child)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1056
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1057
	    if {[info exists parents($child)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1058
		foreach p $parents($child) {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1059
		    if {[info exists colormap($p)]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1060
			&& [lsearch -exact $badcolors $colormap($p)] < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1061
			lappend badcolors $colormap($p)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1062
		    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1063
		}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1064
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1065
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1066
	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
  1067
	    set badcolors $origbad
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1068
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1069
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1070
    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
  1071
	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
  1072
	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
  1073
	    set nextcolor 0
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1074
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1075
	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
  1076
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1077
    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
  1078
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1079
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1080
proc initgraph {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1081
    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
  1082
    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
  1083
    global nchildren ncleft
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1084
    global displist nhyperspace
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
    allcanvs delete all
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1087
    set nextcolor 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1088
    set canvy $canvy0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1089
    set lineno -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1090
    set numcommits 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1091
    catch {unset mainline}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1092
    catch {unset mainlinearrow}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1093
    catch {unset sidelines}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1094
    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
  1095
	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
  1096
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1097
    set displist {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1098
    set nhyperspace 0
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 bindline {t id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1102
    global canv
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1103
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1104
    $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
  1105
    $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
  1106
    $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
  1107
    $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
  1108
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1109
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1110
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
  1111
    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
  1112
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1113
    $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
  1114
    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
  1115
	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
  1116
		   -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
  1117
		   -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
  1118
		   -arrow $mainlinearrow($id)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1119
	$canv lower $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1120
	bindline $t $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1121
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1122
    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
  1123
	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
  1124
	    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
  1125
	    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
  1126
	    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
  1127
	    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
  1128
		       -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
  1129
		       -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
  1130
	    $canv lower $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1131
	    bindline $t $id
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1132
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1133
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1134
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1135
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1136
# 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
  1137
proc drawcommitline {level} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1138
    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
  1139
    global canv canv2 canv3 mainfont namefont canvy linespc
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1140
    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
  1141
    global colormap numcommits currentparents dupparents
13461
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  1142
    global idtags idline idheads idotherrefs idbookmarks
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1143
    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
  1144
    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
  1145
    global oldnlines olddlevel olddisplist
24513
b5a0b2374eb6 hgk: display obsolete changesets in darkgrey
Andrew Shadura <andrew@shadura.me>
parents: 24512
diff changeset
  1146
    global aucolormap curid curidfont obsolete
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1147
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1148
    incr numcommits
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1149
    incr lineno
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1150
    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
  1151
    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
  1152
    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
  1153
    set idline($id) $lineno
24529
14873da80bc1 hgk: show secret changesets differently (shape and label)
Andrew Shadura <andrew@shadura.me>
parents: 24515
diff changeset
  1154
    set shape oval
24530
2ace3b77aaef hgk: set distinct fill and outline colour for non-public and obsolete changesets
Andrew Shadura <andrew@shadura.me>
parents: 24529
diff changeset
  1155
    set outline #000080
2ace3b77aaef hgk: set distinct fill and outline colour for non-public and obsolete changesets
Andrew Shadura <andrew@shadura.me>
parents: 24529
diff changeset
  1156
    set ofill [expr {[info exists commitlisted($id)]? "#7f7fff": "white"}]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1157
    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
  1158
	readcommit $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1159
	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
  1160
	    set commitinfo($id) {"No commit information available"}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1161
	    set nparents($id) 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1162
	}
24529
14873da80bc1 hgk: show secret changesets differently (shape and label)
Andrew Shadura <andrew@shadura.me>
parents: 24515
diff changeset
  1163
    } else {
24530
2ace3b77aaef hgk: set distinct fill and outline colour for non-public and obsolete changesets
Andrew Shadura <andrew@shadura.me>
parents: 24529
diff changeset
  1164
	switch [lindex $commitinfo($id) 9] secret {
24529
14873da80bc1 hgk: show secret changesets differently (shape and label)
Andrew Shadura <andrew@shadura.me>
parents: 24515
diff changeset
  1165
	    set shape rect
24530
2ace3b77aaef hgk: set distinct fill and outline colour for non-public and obsolete changesets
Andrew Shadura <andrew@shadura.me>
parents: 24529
diff changeset
  1166
	} public {
2ace3b77aaef hgk: set distinct fill and outline colour for non-public and obsolete changesets
Andrew Shadura <andrew@shadura.me>
parents: 24529
diff changeset
  1167
	    set outline black
2ace3b77aaef hgk: set distinct fill and outline colour for non-public and obsolete changesets
Andrew Shadura <andrew@shadura.me>
parents: 24529
diff changeset
  1168
	    set ofill blue
24529
14873da80bc1 hgk: show secret changesets differently (shape and label)
Andrew Shadura <andrew@shadura.me>
parents: 24515
diff changeset
  1169
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1170
    }
24513
b5a0b2374eb6 hgk: display obsolete changesets in darkgrey
Andrew Shadura <andrew@shadura.me>
parents: 24512
diff changeset
  1171
    if {[info exists obsolete($id)]} {
24530
2ace3b77aaef hgk: set distinct fill and outline colour for non-public and obsolete changesets
Andrew Shadura <andrew@shadura.me>
parents: 24529
diff changeset
  1172
	set outline darkgrey
2ace3b77aaef hgk: set distinct fill and outline colour for non-public and obsolete changesets
Andrew Shadura <andrew@shadura.me>
parents: 24529
diff changeset
  1173
	set ofill lightgrey
24513
b5a0b2374eb6 hgk: display obsolete changesets in darkgrey
Andrew Shadura <andrew@shadura.me>
parents: 24512
diff changeset
  1174
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1175
    assigncolor $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1176
    set currentparents {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1177
    set dupparents {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1178
    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
  1179
	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
  1180
	    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
  1181
		lappend currentparents $p
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1182
	    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1183
		# 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
  1184
		lappend dupparents $p
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
	}
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
    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
  1189
    set y1 $canvy
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1190
    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
  1191
    allcanvs conf -scrollregion \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1192
	[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
  1193
    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
  1194
	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
  1195
	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
  1196
	    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
  1197
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1198
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1199
    drawlines $id 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1200
    set orad [expr {$linespc / 3}]
24529
14873da80bc1 hgk: show secret changesets differently (shape and label)
Andrew Shadura <andrew@shadura.me>
parents: 24515
diff changeset
  1201
    set t [$canv create $shape [expr $x - $orad] [expr $y1 - $orad] \
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1202
	       [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
24530
2ace3b77aaef hgk: set distinct fill and outline colour for non-public and obsolete changesets
Andrew Shadura <andrew@shadura.me>
parents: 24529
diff changeset
  1203
	       -fill $ofill -outline $outline -width 1]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1204
    $canv raise $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1205
    $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
  1206
    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
  1207
    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
  1208
	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
  1209
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1210
    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
  1211
    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
  1212
    if {[info exists idtags($id)] || [info exists idheads($id)]
13461
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  1213
	|| [info exists idotherrefs($id)] || [info exists idbookmarks($id)]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1214
	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
  1215
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1216
    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
  1217
    set name [lindex $commitinfo($id) 1]
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1218
    assignauthorcolor $name
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1219
    set fg $aucolormap($name)
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1220
    if {$id == $curid} {
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1221
	set fn $curidfont
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1222
    } else {
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1223
	set fn $mainfont
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1224
    }
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1225
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1226
    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
  1227
    set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1228
			       -text $headline -font $fn \
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1229
			       -fill $fg]
5392
66d7aabf5b41 hgk: fix right-mouse button handling under macosx
Patrick Mezard <pmezard@gmail.com>
parents: 5284
diff changeset
  1230
    $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
  1231
    set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1232
			       -text $name -font $namefont \
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1233
			       -fill $fg]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1234
    set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1235
			       -text $date -font $mainfont \
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  1236
			       -fill $fg]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1237
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1238
    set olddlevel $level
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1239
    set olddisplist $displist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1240
    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
  1241
}
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
proc drawtags {id x xt y1} {
13462
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1244
    global bookmarkcurrent idtags idbookmarks idheads idotherrefs commitinfo
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1245
    global linespc lthickness
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1246
    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
  1247
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1248
    set marks {}
13462
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1249
    set nbookmarks 0
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1250
    set ntags 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1251
    set nheads 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1252
    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
  1253
	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
  1254
	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
  1255
    }
13462
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1256
    if {[info exists idbookmarks($id)]} {
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1257
	set marks [concat $marks $idbookmarks($id)]
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1258
	set nbookmarks [llength $idbookmarks($id)]
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1259
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1260
    if {[info exists idheads($id)]} {
7039
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
  1261
	set headmark [lindex $commitinfo($id) 7]
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
  1262
	if {$headmark ne "default"} {
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
  1263
	    lappend marks $headmark
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
  1264
	    set nheads 1
aafe12bd7174 hgk: Display branch name for each head (issue 740)
Michael Sommerville <msommerville@gmail.com>
parents: 6361
diff changeset
  1265
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1266
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1267
    if {$marks eq {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1268
	return $xt
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
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1271
    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
  1272
    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
  1273
    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
  1274
    set xvals {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1275
    set wvals {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1276
    foreach tag $marks {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1277
	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
  1278
	lappend xvals $xt
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1279
	lappend wvals $wid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1280
	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
  1281
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1282
    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
  1283
	       -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
  1284
    $canv lower $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1285
    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
  1286
	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
  1287
	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
  1288
	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
  1289
	    # draw a tag
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1290
	    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
  1291
		       $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
  1292
		       -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
  1293
	    $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
  1294
	    set rowtextx($idline($id)) [expr {$xr + $linespc}]
13462
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1295
	} elseif {[incr nbookmarks -1] >= 0} {
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1296
            # draw a tag
22631
d246eb9cabbc hgk: define bookmark colour explicitly, as Tk 8.6 has changed their meaning
Andrew Shadura <andrew@shadura.me>
parents: 20935
diff changeset
  1297
            set col "#7f7f7f"
13462
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1298
            if {[string compare $bookmarkcurrent $tag] == 0} {
22631
d246eb9cabbc hgk: define bookmark colour explicitly, as Tk 8.6 has changed their meaning
Andrew Shadura <andrew@shadura.me>
parents: 20935
diff changeset
  1299
                set col "#bebebe"
13462
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1300
            }
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1301
            set xl [expr $xl - $delta/2]
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1302
            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1303
                -width 1 -outline black -fill $col -tags tag.$id
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1304
        } else {
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1305
            # draw a head or other ref
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1306
            if {[incr nheads -1] >= 0} {
17960
d0d99c8bdf51 hgk: specify some colours explicitly in hex
Andrew Shadura <bugzilla@tut.by>
parents: 17958
diff changeset
  1307
                set col "#00ff00"
13462
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1308
            } else {
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1309
                set col "#ddddff"
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1310
            }
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1311
            set xl [expr $xl - $delta/2]
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1312
            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
8641cb094c81 hgk: display bookmarks as gray labels in the commitline
David Soria Parra <dsp@php.net>
parents: 13461
diff changeset
  1313
                -width 1 -outline black -fill $col -tags tag.$id
1240
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 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
  1316
		   -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
  1317
	if {$ntags >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1318
	    $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
  1319
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1320
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1321
    return $xt
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1322
}
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
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
  1325
    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
  1326
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1327
    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
  1328
	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
  1329
	if {$p == {}} continue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1330
	if {$i == $corner} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1331
	    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
  1332
		|| [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
  1333
		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
  1334
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1335
	    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
  1336
		|| [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
  1337
		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
  1338
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1339
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1340
	    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
  1341
		|| [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
  1342
		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
  1343
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1344
	    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
  1345
		|| [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
  1346
		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
  1347
	    }
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
    }
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
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1352
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
  1353
    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
  1354
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1355
    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
  1356
    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
  1357
	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
  1358
    } elseif {$i > $level} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1359
	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
  1360
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1361
    return $x
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1362
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1363
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1364
# 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
  1365
proc trimdiagend {line} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1366
    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
  1367
	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
  1368
	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
  1369
	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
  1370
	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
  1371
	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
  1372
	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
  1373
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1374
    return $line
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1375
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1376
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1377
proc trimdiagstart {line} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1378
    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
  1379
	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
  1380
	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
  1381
	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
  1382
	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
  1383
	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
  1384
	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
  1385
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1386
    return $line
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1387
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1388
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1389
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
  1390
    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
  1391
    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
  1392
    global currentparents dupparents
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1393
    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
  1394
    global maxgraphpct maxwidth
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1395
    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
  1396
    global parents commitlisted
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1397
    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
  1398
    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
  1399
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1400
    if {$lineno < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1401
	lappend displist $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1402
	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
  1403
	return 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1404
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1405
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1406
    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
  1407
    set y2 $canvy
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1408
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1409
    # 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
  1410
    set reins {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1411
    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
  1412
	# 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
  1413
	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
  1414
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1415
    # 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
  1416
    foreach p $currentparents {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1417
	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
  1418
	    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
  1419
	}
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
    # 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
  1422
    if {$needonscreen ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1423
	lappend reins $needonscreen
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1424
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1425
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1426
    # try the shortcut
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1427
    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
  1428
	set dlevel $olddlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1429
	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
  1430
	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
  1431
	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
  1432
	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
  1433
	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
  1434
	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
  1435
	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
  1436
	return $dlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1437
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1438
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1439
    # update displist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1440
    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
  1441
    set j $olddlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1442
    foreach p $currentparents {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1443
	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
  1444
	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
  1445
	    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
  1446
	    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
  1447
	    incr j
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1448
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1449
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1450
    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
  1451
	lappend displist $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1452
	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
  1453
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1454
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1455
    # 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
  1456
    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
  1457
    if {$nullentry >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1458
	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
  1459
    }
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
    # 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
  1462
    # 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
  1463
    foreach pi $reins {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1464
	# 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
  1465
	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
  1466
	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
  1467
	    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
  1468
	    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
  1469
	    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
  1470
	    incr nhyperspace -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1471
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1472
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1473
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1474
    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
  1475
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1476
    # 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
  1477
    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
  1478
    if {$displ > $maxwidth} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1479
	set ages {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1480
	foreach x $displist {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1481
	    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
  1482
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1483
	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
  1484
	set k 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1485
	while {$displ > $maxwidth} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1486
	    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
  1487
	    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
  1488
	    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
  1489
	    incr k
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1490
	    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
  1491
	    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
  1492
	    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
  1493
	    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
  1494
	    incr nhyperspace
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1495
	    incr displ -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1496
	    if {$i < $nullentry} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1497
		incr nullentry -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1498
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1499
	    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
  1500
	    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
  1501
	    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
  1502
	    set arrow "last"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1503
	    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
  1504
		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
  1505
		set arrow "both"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1506
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1507
	    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
  1508
	    unset mainline($victim)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1509
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1510
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1511
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1512
    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
  1513
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1514
    # 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
  1515
    if {$displ < $oldnlines} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1516
	# 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
  1517
	# 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
  1518
	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
  1519
	    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
  1520
	} 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
  1521
	    set i $olddlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1522
	    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
  1523
		incr i -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1524
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1525
	} elseif {$nullentry >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1526
	    set i $nullentry
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1527
	    while {$i < $displ
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1528
		   && [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
  1529
		incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1530
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1531
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1532
	    set i $olddlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1533
	    if {$dlevel >= $i} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1534
		incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1535
	    }
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
	if {$i < $displ} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1538
	    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
  1539
	    incr displ
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1540
	    if {$dlevel >= $i} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1541
		incr dlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1542
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1543
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1544
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1545
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1546
    # 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
  1547
    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
  1548
    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
  1549
    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
  1550
	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
  1551
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1552
	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
  1553
	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
  1554
	    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
  1555
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1556
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1557
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1558
    foreach idi $reins {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1559
	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
  1560
	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
  1561
	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
  1562
	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
  1563
	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
  1564
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1565
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1566
    set i -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1567
    foreach id $olddisplist {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1568
	incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1569
	if {$id == {}} continue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1570
	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
  1571
	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
  1572
	if {$i == $olddlevel} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1573
	    foreach p $currentparents {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1574
		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
  1575
		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
  1576
		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
  1577
		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
  1578
		    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
  1579
		    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
  1580
		} 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
  1581
		    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
  1582
		    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
  1583
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1584
		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
  1585
		    # 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
  1586
		    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
  1587
		    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
  1588
		    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
  1589
			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
  1590
			set mainlinearrow($p) none
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1591
		    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1592
		} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1593
		    # 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
  1594
		    set yb $y2
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1595
		    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
  1596
		    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
  1597
			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
  1598
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1599
		    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
  1600
			if {$xi != $xj} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1601
			    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
  1602
			}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1603
			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
  1604
			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
  1605
		    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1606
			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
  1607
			if {$yb < $y2} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1608
			    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
  1609
			}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1610
			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
  1611
		    }
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
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1615
	    set j $i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1616
	    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
  1617
		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
  1618
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1619
	    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
  1620
		|| ($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
  1621
		|| ($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
  1622
		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
  1623
		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
  1624
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1625
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1626
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1627
    return $dlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1628
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1629
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1630
# 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
  1631
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
  1632
    set i 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1633
    foreach l $llist {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1634
	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
  1635
	    return $i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1636
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1637
	incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1638
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1639
    return -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1640
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1641
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1642
proc drawmore {reading} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1643
    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
  1644
    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
  1645
    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
  1646
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1647
    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
  1648
    while {$numcommits < $n} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1649
	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
  1650
	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
  1651
	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
  1652
	    set ctxend $n
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1653
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1654
	set dlist {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1655
	if {$numcommits > 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1656
	    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
  1657
	    set i $olddlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1658
	    foreach p $currentparents {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1659
		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
  1660
		    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
  1661
		    incr i
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1662
		}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1663
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1664
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1665
	set nohs {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1666
	set reins {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1667
	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
  1668
	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
  1669
	    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
  1670
	    # 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
  1671
	    # 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
  1672
	    set room 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1673
	    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
  1674
		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
  1675
		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
  1676
		if {$i < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1677
		    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
  1678
		    lappend dlist $x
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1679
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1680
		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
  1681
		    lappend nohs $x
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1682
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1683
		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
  1684
		    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
  1685
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1686
		set newp {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1687
		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
  1688
		    set right 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1689
		    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
  1690
			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
  1691
			    lappend newp $p
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1692
			    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
  1693
				lappend nohs $p
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1694
			    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1695
			    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
  1696
				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
  1697
			    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1698
			}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1699
			set right 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1700
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1701
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1702
		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
  1703
		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
  1704
		    set l $newp
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1705
		} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1706
		    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
  1707
		    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
  1708
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1709
		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
  1710
		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
  1711
		    set room 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1712
		}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1713
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1714
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1715
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1716
	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
  1717
	drawcommitline $dlevel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1718
	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
  1719
	    && $numcommits >= $ncmupdate} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1720
	    doupdate $reading
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1721
	    if {$stopped} break
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1722
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1723
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1724
}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1725
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1726
# 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
  1727
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
  1728
    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
  1729
    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
  1730
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1731
    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
  1732
    set olds {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1733
    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
  1734
	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
  1735
	    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
  1736
		lappend olds $p
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1737
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1738
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1739
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1740
    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
  1741
	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
  1742
	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
  1743
	    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
  1744
	    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
  1745
	    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
  1746
	    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
  1747
	    return 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1748
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1749
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1750
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1751
    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
  1752
    set i $level
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1753
    set n 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1754
    foreach p $olds {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1755
	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
  1756
	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
  1757
	if {$k < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1758
	    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
  1759
	    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
  1760
	    incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1761
	    incr n
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1762
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1763
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1764
    set nnewparents($id) $n
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1765
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1766
    return 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1767
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1768
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1769
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
  1770
    global ncleft todo
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1771
    global datemode cdate
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1772
    global commitinfo
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1773
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1774
    # 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
  1775
    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
  1776
    set level -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1777
    set latest {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1778
    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
  1779
	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
  1780
	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
  1781
	    if {$datemode} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1782
		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
  1783
		    if {$noread} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1784
			return {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1785
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1786
		    readcommit $p
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1787
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1788
		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
  1789
		    set level $k
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1790
		    set latest $cdate($p)
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1791
		}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1792
	    } else {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1793
		set level $k
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1794
		break
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1795
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1796
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1797
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1798
    if {$level < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1799
	if {$todo != {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1800
	    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
  1801
	    foreach p $todo {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1802
		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
  1803
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1804
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1805
	return -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1806
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1807
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1808
    return $level
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1809
}
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
proc drawcommit {id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1812
    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
  1813
    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
  1814
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1815
    if {$phase != "incrdraw"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1816
	set phase incrdraw
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1817
	set displayorder {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1818
	set todo {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1819
	initgraph
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1820
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1821
    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
  1822
	lappend todo $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1823
	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
  1824
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1825
    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
  1826
    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
  1827
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1828
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1829
    while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1830
	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
  1831
	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
  1832
	    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
  1833
	    if {$level == {}} break
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 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
  1836
	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
  1837
	    break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1838
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1839
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1840
    drawmore 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1841
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1842
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1843
proc finishcommits {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1844
    global phase
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1845
    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
  1846
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1847
    if {$phase != "incrdraw"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1848
	$canv delete all
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1849
	$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
  1850
	    -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
  1851
	set phase {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1852
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1853
	drawrest
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1854
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1855
    . config -cursor $maincursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1856
    settextcursor $textcursor
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
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1859
# 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
  1860
# 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
  1861
proc settextcursor {c} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1862
    global ctext curtextcursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1863
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1864
    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
  1865
	$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
  1866
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1867
    set curtextcursor $c
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
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1870
proc drawgraph {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1871
    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
  1872
    global displayorder onscreen
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1873
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1874
    if {$displayorder == {}} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1875
    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
  1876
    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
  1877
    set ncmupdate 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1878
    initgraph
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1879
    foreach id $displayorder {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1880
	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
  1881
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1882
    drawmore 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1883
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1884
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1885
proc drawrest {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1886
    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
  1887
    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
  1888
    global numcommits ncmupdate
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1889
    global nextupdate startmsecs
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1890
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1891
    set level [decidenext]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1892
    if {$level >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1893
	set phase drawgraph
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1894
	while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1895
	    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
  1896
	    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
  1897
	    if {$hard} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1898
		set level [decidenext]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1899
		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
  1900
	    }
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
	drawmore 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1903
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1904
    set phase {}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1905
    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
  1906
    #puts "overall $drawmsecs ms for $numcommits commits"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1907
    if {$redisplaying} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1908
	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
  1909
	    selectline $selectedline 0
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1910
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1911
	if {$stopped == 1} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1912
	    set stopped 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1913
	    after idle drawgraph
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1914
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1915
	    set redisplaying 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1916
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1917
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1918
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1919
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1920
proc findmatches {f} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1921
    global findtype foundstring foundstrlen
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1922
    if {$findtype == "Regexp"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1923
	set matches [regexp -indices -all -inline $foundstring $f]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1924
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1925
	if {$findtype == "IgnCase"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1926
	    set str [string tolower $f]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1927
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1928
	    set str $f
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1929
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1930
	set matches {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1931
	set i 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1932
	while {[set j [string first $foundstring $str $i]] >= 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1933
	    lappend matches [list $j [expr $j+$foundstrlen-1]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1934
	    set i [expr $j + $foundstrlen]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1935
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1936
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1937
    return $matches
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1938
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1939
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1940
proc dofind {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1941
    global findtype findloc findstring markedmatches commitinfo
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1942
    global numcommits lineid linehtag linentag linedtag
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1943
    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
  1944
    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
  1945
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1946
    stopfindproc
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1947
    unmarkmatches
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1948
    focus .
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1949
    set matchinglines {}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1950
    if {$findloc == "Pickaxe"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1951
	findpatches
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1952
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1953
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1954
    if {$findtype == "IgnCase"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1955
	set foundstring [string tolower $findstring]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1956
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1957
	set foundstring $findstring
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1958
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1959
    set foundstrlen [string length $findstring]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1960
    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
  1961
    if {$findloc == "Files"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1962
	findfiles
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1963
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  1964
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1965
    if {![info exists selectedline]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1966
	set oldsel -1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1967
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1968
	set oldsel $selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1969
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1970
    set didsel 0
18801
c84cc0f3364a hgk: drop committer field from the UI
Andrew Shadura <bugzilla@tut.by>
parents: 18561
diff changeset
  1971
    set fldtypes {Headline Author Date CDate Comment}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1972
    for {set l 0} {$l < $numcommits} {incr l} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1973
	set id $lineid($l)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1974
	set info $commitinfo($id)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1975
	set doesmatch 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1976
	foreach f $info ty $fldtypes {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1977
	    if {$findloc != "All fields" && $findloc != $ty} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1978
		continue
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1979
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1980
	    set matches [findmatches $f]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1981
	    if {$matches == {}} continue
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1982
	    set doesmatch 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1983
	    if {$ty == "Headline"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1984
		markmatches $canv $l $f $linehtag($l) $matches $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1985
	    } elseif {$ty == "Author"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1986
		markmatches $canv2 $l $f $linentag($l) $matches $namefont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1987
	    } elseif {$ty == "Date"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1988
		markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1989
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1990
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1991
	if {$doesmatch} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1992
	    lappend matchinglines $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1993
	    if {!$didsel && $l > $oldsel} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1994
		findselectline $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1995
		set didsel 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1996
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1997
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1998
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  1999
    if {$matchinglines == {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2000
	bell
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2001
    } elseif {!$didsel} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2002
	findselectline [lindex $matchinglines 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2003
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2004
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2005
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2006
proc findselectline {l} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2007
    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
  2008
    selectline $l 1
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2009
    if {$findloc == "All fields" || $findloc == "Comments"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2010
	# highlight the matches in the comments
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2011
	set f [$ctext get 1.0 $commentend]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2012
	set matches [findmatches $f]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2013
	foreach match $matches {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2014
	    set start [lindex $match 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2015
	    set end [expr [lindex $match 1] + 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2016
	    $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
  2017
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2018
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2019
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2020
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2021
proc findnext {restart} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2022
    global matchinglines selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2023
    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
  2024
	if {$restart} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2025
	    dofind
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2026
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2027
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2028
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2029
    if {![info exists selectedline]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2030
    foreach l $matchinglines {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2031
	if {$l > $selectedline} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2032
	    findselectline $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2033
	    return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2034
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2035
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2036
    bell
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2037
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2038
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2039
proc findprev {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2040
    global matchinglines selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2041
    if {![info exists matchinglines]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2042
	dofind
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2043
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2044
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2045
    if {![info exists selectedline]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2046
    set prev {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2047
    foreach l $matchinglines {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2048
	if {$l >= $selectedline} break
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2049
	set prev $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2050
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2051
    if {$prev != {}} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2052
	findselectline $prev
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2053
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2054
	bell
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2055
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2056
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2057
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2058
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
  2059
    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
  2060
    if {$findloc == "Pickaxe"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2061
	set findtype Exact
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2062
	set state disabled
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2063
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2064
	set state normal
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2065
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2066
    $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
  2067
    $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
  2068
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2069
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2070
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
  2071
    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
  2072
    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
  2073
    global findinprogress
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2074
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2075
    catch {unset findids}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2076
    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
  2077
	if {!$done} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2078
	    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
  2079
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2080
	catch {close $findprocfile}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2081
	unset findprocpid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2082
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2083
    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
  2084
	unset findinprogress
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2085
	if {$phase != "incrdraw"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2086
	    . config -cursor $maincursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2087
	    settextcursor $textcursor
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2088
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2089
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2090
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2091
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2092
proc findpatches {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2093
    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
  2094
    global findprocpid findprocfile
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2095
    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
  2096
    global findinsertpos
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
  2097
    global env
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2098
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2099
    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
  2100
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2101
    # 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
  2102
    # 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
  2103
    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
  2104
	set l $selectedline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2105
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2106
	set l -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2107
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2108
    set inputids {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2109
    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
  2110
	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
  2111
	    set l 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2112
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2113
	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
  2114
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2115
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2116
    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
  2117
	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
  2118
    } err]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2119
	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
  2120
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2121
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2122
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2123
    set findinsertpos end
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2124
    set findprocfile $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2125
    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
  2126
    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
  2127
    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
  2128
    set finddidsel 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2129
    . config -cursor watch
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2130
    settextcursor watch
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2131
    set findinprogress 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2132
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2133
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2134
proc readfindproc {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2135
    global findprocfile finddidsel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2136
    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
  2137
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2138
    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
  2139
    if {$n < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2140
	if {[eof $findprocfile]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2141
	    stopfindproc 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2142
	    if {!$finddidsel} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2143
		bell
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
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2146
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2147
    }
3059
3dab573a4330 hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents: 2297
diff changeset
  2148
    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
  2149
	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
  2150
	stopfindproc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2151
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2152
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2153
    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
  2154
	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
  2155
	return
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
    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
  2158
    insertmatch $l $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2159
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2160
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2161
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
  2162
    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
  2163
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2164
    if {$findinsertpos == "end"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2165
	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
  2166
	    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
  2167
	    set findinsertpos 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2168
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2169
	    lappend matchinglines $l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2170
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2171
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2172
	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
  2173
	incr findinsertpos
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2174
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2175
    markheadline $l $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2176
    if {!$finddidsel} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2177
	findselectline $l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2178
	set finddidsel 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2179
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2180
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2181
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2182
proc findfiles {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2183
    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
  2184
    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
  2185
    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
  2186
    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
  2187
    global findmergefiles
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
  2188
    global env
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2189
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2190
    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
  2191
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2192
    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
  2193
	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
  2194
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2195
	set l 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2196
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2197
    set ffileline $l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2198
    set findstartline $l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2199
    set diffsneeded {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2200
    set fdiffsneeded {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2201
    while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2202
	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
  2203
	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
  2204
	    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
  2205
		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
  2206
		    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
  2207
		    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
  2208
		}
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
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2211
	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
  2212
	    set l 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2213
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2214
	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
  2215
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2216
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2217
    # 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
  2218
    if {$diffsneeded ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2219
	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
  2220
	    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
  2221
	} err ]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2222
	    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
  2223
	    return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2224
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2225
	catch {unset fdiffids}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2226
	set fdiffpos 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2227
	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
  2228
	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
  2229
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2230
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2231
    set finddidsel 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2232
    set findinsertpos end
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2233
    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
  2234
    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
  2235
    . config -cursor watch
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2236
    settextcursor watch
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2237
    set findinprogress 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2238
    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
  2239
    update
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2240
}
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
proc readfilediffs {df} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2243
    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
  2244
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2245
    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
  2246
    if {$n < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2247
	if {[eof $df]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2248
	    donefilediff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2249
	    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
  2250
		stopfindproc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2251
		bell
1278
6a0d373d3126 hgit -> hgk.py
mpm@selenic.com
parents: 1240
diff changeset
  2252
		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
  2253
	    } 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
  2254
		set ids $findids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2255
		stopfindproc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2256
		bell
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2257
		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
  2258
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2259
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2260
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2261
    }
3059
3dab573a4330 hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents: 2297
diff changeset
  2262
    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
  2263
	# 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
  2264
	donefilediff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2265
	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
  2266
	set fdiffs {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2267
    } 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
  2268
	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
  2269
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2270
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2271
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2272
proc donefilediff {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2273
    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
  2274
    global fdiffsneeded fdiffpos
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
    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
  2277
	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
  2278
	       && $fdiffpos < [llength $fdiffsneeded]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2279
	    # 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
  2280
	    # 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
  2281
	    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
  2282
	    set treediffs($nullids) {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2283
	    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
  2284
		unset findids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2285
		findcont $nullids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2286
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2287
	    incr fdiffpos
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2288
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2289
	incr fdiffpos
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 {![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
  2292
	    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
  2293
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2294
	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
  2295
	    unset findids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2296
	    findcont $fdiffids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2297
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2298
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2299
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2300
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2301
proc findcont {ids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2302
    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
  2303
    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
  2304
    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
  2305
    global findmergefiles
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2306
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2307
    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
  2308
    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
  2309
    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
  2310
    set l $ffileline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2311
    while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2312
	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
  2313
	    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
  2314
		set findids $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2315
		set ffileline $l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2316
		return
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
	    set doesmatch 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2319
	    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
  2320
		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
  2321
		if {$x != {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2322
		    set doesmatch 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2323
		    break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2324
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2325
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2326
	    if {$doesmatch} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2327
		insertmatch $l $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2328
		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
  2329
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2330
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2331
	    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
  2332
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2333
	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
  2334
	    set pi 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2335
	    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
  2336
		set l 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2337
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2338
	    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
  2339
	    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
  2340
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2341
	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
  2342
	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
  2343
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2344
    stopfindproc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2345
    if {!$finddidsel} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2346
	bell
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2347
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2348
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2349
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2350
# 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
  2351
# behind the headline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2352
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
  2353
    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
  2354
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2355
    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
  2356
    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
  2357
    $canv lower $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2358
}
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
# 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
  2361
proc markmatches {canv l str tag matches font} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2362
    set bbox [$canv bbox $tag]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2363
    set x0 [lindex $bbox 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2364
    set y0 [lindex $bbox 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2365
    set y1 [lindex $bbox 3]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2366
    foreach match $matches {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2367
	set start [lindex $match 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2368
	set end [lindex $match 1]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2369
	if {$start > $end} continue
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2370
	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
  2371
	set xlen [font measure $font [string range $str 0 [expr $end]]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2372
	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
  2373
		   -outline {} -tags matches -fill yellow]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2374
	$canv lower $t
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2375
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2376
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2377
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2378
proc unmarkmatches {} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2379
    global matchinglines findids
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2380
    allcanvs delete matches
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2381
    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
  2382
    catch {unset findids}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2383
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2384
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2385
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
  2386
    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
  2387
    global lineid linehtag linentag linedtag rowtextx
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2388
    set ymax [lindex [$canv cget -scrollregion] 3]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2389
    if {$ymax == {}} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2390
    set yfrac [lindex [$canv yview] 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2391
    set y [expr {$y + $yfrac * $ymax}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2392
    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2393
    if {$l < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2394
	set l 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2395
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2396
    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
  2397
	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
  2398
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2399
    unmarkmatches
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2400
    selectline $l 1
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
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
  2404
    global commitinfo
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2405
    set l "..."
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2406
    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
  2407
	set l [lindex $commitinfo($p) 0]
3092
d0fcce3728d1 hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents: 3059
diff changeset
  2408
	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
  2409
    }
3092
d0fcce3728d1 hgk: add revision numbers
Brendan Cully <brendan@kublai.com>
parents: 3059
diff changeset
  2410
    return "$r:$p ($l)"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2411
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2412
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2413
# 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
  2414
# 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
  2415
proc appendwithlinks {text} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2416
    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
  2417
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2418
    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
  2419
    $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
  2420
    $ctext insert end "\n"
3059
3dab573a4330 hgk: use short changeset hashes
TK Soh <teekaysoh@yahoo.com>
parents: 2297
diff changeset
  2421
    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
  2422
    foreach l $links {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2423
	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
  2424
	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
  2425
	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
  2426
	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
  2427
	incr e
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2428
	$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
  2429
	$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
  2430
	$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
  2431
	incr linknum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2432
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2433
    $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
  2434
    $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
  2435
    $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
  2436
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2437
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2438
proc selectline {l isnew} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2439
    global canv canv2 canv3 ctext commitinfo selectedline
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2440
    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
  2441
    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
  2442
    global cflist currentid sha1entry
13463
22f948c027a9 hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents: 13462
diff changeset
  2443
    global commentend idtags idbookmarks idline linknum
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2444
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2445
    $canv delete hover
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2446
    normalline
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2447
    if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2448
    $canv delete secsel
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2449
    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2450
	       -tags secsel -fill [$canv cget -selectbackground]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2451
    $canv lower $t
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2452
    $canv2 delete secsel
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2453
    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2454
	       -tags secsel -fill [$canv2 cget -selectbackground]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2455
    $canv2 lower $t
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2456
    $canv3 delete secsel
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2457
    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2458
	       -tags secsel -fill [$canv3 cget -selectbackground]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2459
    $canv3 lower $t
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2460
    set y [expr {$canvy0 + $l * $linespc}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2461
    set ymax [lindex [$canv cget -scrollregion] 3]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2462
    set ytop [expr {$y - $linespc - 1}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2463
    set ybot [expr {$y + $linespc + 1}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2464
    set wnow [$canv yview]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2465
    set wtop [expr [lindex $wnow 0] * $ymax]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2466
    set wbot [expr [lindex $wnow 1] * $ymax]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2467
    set wh [expr {$wbot - $wtop}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2468
    set newtop $wtop
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2469
    if {$ytop < $wtop} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2470
	if {$ybot < $wtop} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2471
	    set newtop [expr {$y - $wh / 2.0}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2472
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2473
	    set newtop $ytop
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2474
	    if {$newtop > $wtop - $linespc} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2475
		set newtop [expr {$wtop - $linespc}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2476
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2477
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2478
    } elseif {$ybot > $wbot} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2479
	if {$ytop > $wbot} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2480
	    set newtop [expr {$y - $wh / 2.0}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2481
	} else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2482
	    set newtop [expr {$ybot - $wh}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2483
	    if {$newtop < $wtop + $linespc} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2484
		set newtop [expr {$wtop + $linespc}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2485
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2486
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2487
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2488
    if {$newtop != $wtop} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2489
	if {$newtop < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2490
	    set newtop 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2491
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2492
	allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2493
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2494
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2495
    if {$isnew} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2496
	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
  2497
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2498
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2499
    set selectedline $l
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2500
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2501
    set id $lineid($l)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2502
    set currentid $id
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2503
    $sha1entry delete 0 end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2504
    $sha1entry insert 0 $id
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  2505
    $sha1entry selection range 0 end
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2506
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2507
    $ctext conf -state normal
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2508
    $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
  2509
    set linknum 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2510
    $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
  2511
    $ctext mark gravity fmark.0 left
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2512
    set info $commitinfo($id)
18802
814498f80d7d hgk: reformat changsets fields
Andrew Shadura <bugzilla@tut.by>
parents: 18801
diff changeset
  2513
    $ctext insert end "Changeset: [lindex $info 6]\n"
5859
e0f86c1e3ae5 hgk: display branch name in diff header
Patrick Mezard <pmezard@gmail.com>
parents: 5662
diff changeset
  2514
    if {[llength [lindex $info 7]] > 0} {
e0f86c1e3ae5 hgk: display branch name in diff header
Patrick Mezard <pmezard@gmail.com>
parents: 5662
diff changeset
  2515
        $ctext insert end "Branch: [lindex $info 7]\n"
e0f86c1e3ae5 hgk: display branch name in diff header
Patrick Mezard <pmezard@gmail.com>
parents: 5662
diff changeset
  2516
    }
18802
814498f80d7d hgk: reformat changsets fields
Andrew Shadura <bugzilla@tut.by>
parents: 18801
diff changeset
  2517
    $ctext insert end "User: [lindex $info 1]\n"
814498f80d7d hgk: reformat changsets fields
Andrew Shadura <bugzilla@tut.by>
parents: 18801
diff changeset
  2518
    $ctext insert end "Date: [lindex $info 2]\n"
24604
ce8dd4fd2d5d hgk: display committer name when set by hg-git
Andrew Shadura <andrew@shadura.me>
parents: 24531
diff changeset
  2519
    if {[lindex $info 3] ne ""} {
ce8dd4fd2d5d hgk: display committer name when set by hg-git
Andrew Shadura <andrew@shadura.me>
parents: 24531
diff changeset
  2520
	$ctext insert end "Committer: [lindex $info 3]\n"
ce8dd4fd2d5d hgk: display committer name when set by hg-git
Andrew Shadura <andrew@shadura.me>
parents: 24531
diff changeset
  2521
    }
13463
22f948c027a9 hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents: 13462
diff changeset
  2522
    if {[info exists idbookmarks($id)]} {
22f948c027a9 hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents: 13462
diff changeset
  2523
	$ctext insert end "Bookmarks:"
22f948c027a9 hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents: 13462
diff changeset
  2524
	foreach bookmark $idbookmarks($id) {
22f948c027a9 hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents: 13462
diff changeset
  2525
	    $ctext insert end " $bookmark"
22f948c027a9 hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents: 13462
diff changeset
  2526
	}
22f948c027a9 hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents: 13462
diff changeset
  2527
	$ctext insert end "\n"
22f948c027a9 hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents: 13462
diff changeset
  2528
    }
22f948c027a9 hgk: display bookmark in commit diff window
David Soria Parra <dsp@php.net>
parents: 13462
diff changeset
  2529
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2530
    if {[info exists idtags($id)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2531
	$ctext insert end "Tags:"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2532
	foreach tag $idtags($id) {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2533
	    $ctext insert end " $tag"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2534
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2535
	$ctext insert end "\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2536
    }
1308
2073e5a71008 Cleanup of tabs and trailing spaces.
Thomas Arendsen Hein <thomas@intevation.de>
parents: 1278
diff changeset
  2537
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2538
    set comment {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2539
    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
  2540
	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
  2541
	    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
  2542
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2543
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2544
    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
  2545
	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
  2546
	    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
  2547
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2548
    }
24529
14873da80bc1 hgk: show secret changesets differently (shape and label)
Andrew Shadura <andrew@shadura.me>
parents: 24515
diff changeset
  2549
14873da80bc1 hgk: show secret changesets differently (shape and label)
Andrew Shadura <andrew@shadura.me>
parents: 24515
diff changeset
  2550
    if {[lindex $info 9] eq "secret"} {
14873da80bc1 hgk: show secret changesets differently (shape and label)
Andrew Shadura <andrew@shadura.me>
parents: 24515
diff changeset
  2551
	# for now, display phase for secret changesets only
14873da80bc1 hgk: show secret changesets differently (shape and label)
Andrew Shadura <andrew@shadura.me>
parents: 24515
diff changeset
  2552
	append comment "Phase: [lindex $info 9]\n"
14873da80bc1 hgk: show secret changesets differently (shape and label)
Andrew Shadura <andrew@shadura.me>
parents: 24515
diff changeset
  2553
    }
14873da80bc1 hgk: show secret changesets differently (shape and label)
Andrew Shadura <andrew@shadura.me>
parents: 24515
diff changeset
  2554
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2555
    append comment "\n"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2556
    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
  2557
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2558
    # 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
  2559
    appendwithlinks $comment
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2560
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2561
    $ctext tag delete Comments
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2562
    $ctext tag remove found 1.0 end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2563
    $ctext conf -state disabled
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2564
    set commentend [$ctext index "end - 1c"]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2565
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2566
    $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
  2567
    $cflist insert end "Comments"
6361
9b21faa6f013 hgk: display orphan revisions content (issue 1041)
Patrick Mezard <pmezard@gmail.com>
parents: 6322
diff changeset
  2568
    if {$nparents($id) <= 1} {
9b21faa6f013 hgk: display orphan revisions content (issue 1041)
Patrick Mezard <pmezard@gmail.com>
parents: 6322
diff changeset
  2569
    set parent "null"
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2570
    if {$nparents($id) == 1} {
6361
9b21faa6f013 hgk: display orphan revisions content (issue 1041)
Patrick Mezard <pmezard@gmail.com>
parents: 6322
diff changeset
  2571
        set parent $parents($id)
9b21faa6f013 hgk: display orphan revisions content (issue 1041)
Patrick Mezard <pmezard@gmail.com>
parents: 6322
diff changeset
  2572
    }
9b21faa6f013 hgk: display orphan revisions content (issue 1041)
Patrick Mezard <pmezard@gmail.com>
parents: 6322
diff changeset
  2573
	startdiff [concat $id $parent]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2574
    } 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
  2575
	mergediff $id
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2576
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2577
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2578
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2579
proc selnextline {dir} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2580
    global selectedline
20764
d9378bfa0af0 hgk: enable selected patch text on Windows
Andrew Shadura <andrew@shadura.me>
parents: 20763
diff changeset
  2581
    focus .
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2582
    if {![info exists selectedline]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2583
    set l [expr $selectedline + $dir]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2584
    unmarkmatches
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2585
    selectline $l 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2586
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2587
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2588
proc unselectline {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2589
    global selectedline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2590
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2591
    catch {unset selectedline}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2592
    allcanvs delete secsel
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2593
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2594
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2595
proc addtohistory {cmd} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2596
    global history historyindex
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 {$historyindex > 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2599
	&& [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
  2600
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2601
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2602
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2603
    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
  2604
	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
  2605
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2606
	lappend history $cmd
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
    incr historyindex
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2609
    if {$historyindex > 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2610
	.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
  2611
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2612
	.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
  2613
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2614
    .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
  2615
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2616
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2617
proc goback {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2618
    global history historyindex
20764
d9378bfa0af0 hgk: enable selected patch text on Windows
Andrew Shadura <andrew@shadura.me>
parents: 20763
diff changeset
  2619
    focus .
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2620
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2621
    if {$historyindex > 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2622
	incr historyindex -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2623
	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
  2624
	eval $cmd
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2625
	.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
  2626
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2627
    if {$historyindex <= 1} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2628
	.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
  2629
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2630
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2631
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2632
proc goforw {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2633
    global history historyindex
20764
d9378bfa0af0 hgk: enable selected patch text on Windows
Andrew Shadura <andrew@shadura.me>
parents: 20763
diff changeset
  2634
    focus .
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2635
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2636
    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
  2637
	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
  2638
	incr historyindex
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2639
	eval $cmd
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2640
	.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
  2641
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2642
    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
  2643
	.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
  2644
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2645
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2646
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2647
proc mergediff {id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2648
    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
  2649
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2650
    set diffmergeid $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2651
    set diffpindex -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2652
    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
  2653
    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
  2654
	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
  2655
	    showmergediff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2656
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2657
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2658
	contmergediff {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2659
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2660
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2661
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2662
proc findgca {ids} {
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
  2663
    global env
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2664
    set gca {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2665
    foreach id $ids {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2666
	if {$gca eq {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2667
	    set gca $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2668
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2669
	    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
  2670
		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
  2671
	    } err]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2672
		return {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2673
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2674
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2675
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2676
    return $gca
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2677
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2678
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2679
proc contmergediff {ids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2680
    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
  2681
    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
  2682
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2683
    # 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
  2684
    # 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
  2685
    while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2686
	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
  2687
	    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
  2688
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2689
	    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
  2690
	    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
  2691
	    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
  2692
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2693
	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
  2694
	    set diffids $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2695
	    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
  2696
		gettreediffs $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2697
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2698
	    return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2699
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2700
    }
1240
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
    # 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
  2703
    # 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
  2704
    # 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
  2705
    # 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
  2706
    if {$diffmergegca ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2707
	set files {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2708
	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
  2709
	    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
  2710
	    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
  2711
		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
  2712
		    && [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
  2713
		    lappend files $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2714
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2715
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2716
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2717
	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
  2718
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2719
	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
  2720
	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
  2721
	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
  2722
	    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
  2723
	    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
  2724
	    set nf {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2725
	    foreach f $files {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2726
		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
  2727
		    lappend nf $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2728
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2729
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2730
	    set files $nf
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2731
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2732
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2733
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2734
    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
  2735
    if {$files ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2736
	showmergediff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2737
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2738
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2739
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2740
proc showmergediff {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2741
    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
  2742
    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
  2743
    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
  2744
    global env
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2745
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2746
    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
  2747
    foreach f $files {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2748
	$cflist insert end $f
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2749
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2750
    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
  2751
    set flist {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2752
    catch {unset currentfile}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2753
    catch {unset currenthunk}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2754
    catch {unset filelines}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2755
    catch {unset groupfilenum}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2756
    catch {unset grouphunks}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2757
    set groupfilelast -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2758
    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
  2759
	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
  2760
	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
  2761
	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
  2762
	    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
  2763
	    foreach f $flist {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2764
		catch {close $f}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2765
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2766
	    return
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
	lappend flist $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2769
	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
  2770
	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
  2771
	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
  2772
	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
  2773
	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
  2774
	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
  2775
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2776
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2777
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2778
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
  2779
    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
  2780
    global currentfile currenthunk
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2781
    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
  2782
    global diffblocked mergefilelist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2783
    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
  2784
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2785
    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
  2786
    if {$n < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2787
	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
  2788
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2789
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2790
    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
  2791
	if {$n < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2792
	    close $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2793
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2794
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2795
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2796
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2797
    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
  2798
	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
  2799
	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
  2800
	    # 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
  2801
	    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
  2802
	    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
  2803
	    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
  2804
		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
  2805
		incr diffoldlno($ids)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2806
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2807
	    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
  2808
		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
  2809
		incr diffnewlno($ids)
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
	    if {$match eq " "} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2812
		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
  2813
		    lappend difflcounts($ids) \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2814
			[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
  2815
		    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
  2816
		    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
  2817
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2818
		incr noldlines($ids)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2819
	    } 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
  2820
		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
  2821
		    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
  2822
		    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
  2823
		    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
  2824
		    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
  2825
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2826
		if {$match eq "-"} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2827
		    incr noldlines($ids)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2828
		} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2829
		    incr nnewlines($ids)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2830
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2831
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2832
	    # 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
  2833
	    return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2834
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2835
	# 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
  2836
	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
  2837
	    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
  2838
	} 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
  2839
		  && ($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
  2840
	    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
  2841
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2842
	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
  2843
				   $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
  2844
				   $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
  2845
				   $difflcounts($ids)]
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2846
	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
  2847
	# -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
  2848
	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
  2849
	processhunks
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2850
	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
  2851
	    fileevent $f readable {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2852
	    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
  2853
	}
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
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2856
    if {$n < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2857
	# eof
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2858
	if {!$diffblocked($ids)} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2859
	    close $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2860
	    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
  2861
	    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
  2862
	    processhunks
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
    } 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
  2865
	# 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
  2866
	set currentfile($ids) \
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2867
	    [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
  2868
    } 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
  2869
		   $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
  2870
	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
  2871
	    # 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
  2872
	    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
  2873
		set f1l 1
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
	    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
  2876
		set f2l 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2877
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2878
	    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
  2879
	    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
  2880
	    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
  2881
	    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
  2882
	    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
  2883
	    set difflcounts($ids) {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2884
	    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
  2885
	    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
  2886
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2887
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2888
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2889
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2890
proc processhunks {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2891
    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
  2892
    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
  2893
    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
  2894
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2895
    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
  2896
    while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2897
	set fi $nfiles
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2898
	set lno 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2899
	# 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
  2900
	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
  2901
	    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
  2902
	    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
  2903
	    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
  2904
	    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
  2905
	    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
  2906
		set fi $i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2907
		set lno $l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2908
		set pi $p
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2909
	    }
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
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2912
	if {$fi < $nfiles} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2913
	    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
  2914
	    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
  2915
	    unset currenthunk($ids)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2916
	    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
  2917
		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
  2918
		    [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
  2919
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2920
	    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
  2921
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2922
	    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
  2923
		&& $lno <= $grouplineend} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2924
		# 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
  2925
		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
  2926
		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
  2927
		if {$endln > $grouplineend} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2928
		    set grouplineend $endln
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2929
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2930
		continue
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2931
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2932
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2933
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2934
	# 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
  2935
	# 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
  2936
	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
  2937
	    processgroup
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2938
	    unset groupfilenum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2939
	    unset grouphunks
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2940
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2941
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2942
	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
  2943
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2944
	# 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
  2945
	set groupfilenum $fi
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2946
	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
  2947
	set grouplinestart $lno
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2948
	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
  2949
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2950
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  2951
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2952
proc processgroup {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2953
    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
  2954
    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
  2955
    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
  2956
    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
  2957
    global mergemax
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2958
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2959
    $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
  2960
    set id $diffmergeid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2961
    set f $groupfilenum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2962
    if {$groupfilelast != $f} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2963
	$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
  2964
	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
  2965
	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
  2966
	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
  2967
	$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
  2968
	$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
  2969
	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
  2970
	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
  2971
	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
  2972
	$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
  2973
	set groupfilelast $f
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2974
	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
  2975
	    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
  2976
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2977
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2978
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2979
    $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
  2980
    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
  2981
    set events {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2982
    set pnum 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2983
    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
  2984
	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
  2985
	set ol $startline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2986
	set nl $grouplinestart
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2987
	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
  2988
	    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
  2989
		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
  2990
		if {$nl < $l} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2991
		    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
  2992
			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
  2993
			incr ol
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2994
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2995
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  2996
		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
  2997
		    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
  2998
			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
  2999
			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
  3000
			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
  3001
			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
  3002
			incr ol $olc
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3003
			set nl $nnl
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3004
		    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3005
			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
  3006
			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
  3007
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3008
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3009
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3010
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3011
	if {$nl < $grouplineend} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3012
	    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
  3013
		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
  3014
		incr ol
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3015
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3016
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3017
	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
  3018
	$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
  3019
	incr pnum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3020
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3021
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3022
    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
  3023
    $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
  3024
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3025
    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
  3026
    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
  3027
    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
  3028
    set l $grouplinestart
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3029
    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
  3030
	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
  3031
	while {$l < $nl} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3032
	    $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
  3033
	    incr l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3034
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3035
	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
  3036
	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
  3037
	set j $i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3038
	set active {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3039
	while 1 {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3040
	    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
  3041
	    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
  3042
	    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
  3043
	    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
  3044
		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
  3045
		lappend active $pnum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3046
	    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3047
		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
  3048
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3049
	    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
  3050
	    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
  3051
	    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
  3052
	    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
  3053
		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
  3054
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3055
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3056
	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
  3057
	set ncol mresult
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3058
	set bestpn -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3059
	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
  3060
	    # 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
  3061
	    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
  3062
		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
  3063
		    if {$pnum < $mergemax} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3064
			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
  3065
		    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3066
			lappend ncol mmax
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3067
		    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3068
		    break
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3069
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3070
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3071
	} 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
  3072
	    # 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
  3073
	    set bestsim 30
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3074
	    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
  3075
		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
  3076
			     [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
  3077
		if {$sim > $bestsim} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3078
		    set bestsim $sim
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3079
		    set bestpn $pnum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3080
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3081
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3082
	    if {$bestpn >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3083
		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
  3084
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3085
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3086
	set pnum -1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3087
	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
  3088
	    incr pnum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3089
	    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
  3090
	    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
  3091
	    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
  3092
	    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
  3093
	    unset delta($pnum)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3094
	    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
  3095
		$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
  3096
		incr ol
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3097
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3098
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3099
	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
  3100
	if {$bestpn >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3101
	    # 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
  3102
	    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
  3103
	    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
  3104
	    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
  3105
	    unset delta($bestpn)
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3106
	    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
  3107
		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
  3108
		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
  3109
		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
  3110
		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
  3111
		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
  3112
		    $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
  3113
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3114
		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
  3115
		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
  3116
		    $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
  3117
		    incr ol
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3118
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3119
		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
  3120
		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
  3121
		    $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
  3122
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3123
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3124
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3125
	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
  3126
	    $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
  3127
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3128
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3129
    while {$l < $grouplineend} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3130
	$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
  3131
	incr l
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3132
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3133
    $ctext conf -state disabled
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3134
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3135
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3136
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
  3137
    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
  3138
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3139
    set id $diffmergeid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3140
    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
  3141
    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
  3142
    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
  3143
    set same 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3144
    set diff 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3145
    foreach e $events {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3146
	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
  3147
	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
  3148
	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
  3149
	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
  3150
	    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
  3151
	    incr same
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3152
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3153
	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
  3154
	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
  3155
	    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
  3156
	    incr diff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3157
	    incr ol
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3158
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3159
	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
  3160
	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
  3161
	    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
  3162
	    incr diff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3163
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3164
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3165
    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
  3166
	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
  3167
	incr same
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3168
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3169
    if {$same == 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3170
	return 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3171
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3172
    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
  3173
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3174
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3175
proc startdiff {ids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3176
    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
  3177
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3178
    set diffids $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3179
    catch {unset diffmergeid}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3180
    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
  3181
	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
  3182
	    gettreediffs $ids
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
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3185
	addtocflist $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3186
    }
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
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3189
proc addtocflist {ids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3190
    global treediffs cflist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3191
    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
  3192
	$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
  3193
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3194
    getblobdiffs $ids
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
proc gettreediffs {ids} {
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
  3198
    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
  3199
    set treepending $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3200
    set treediff {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3201
    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
  3202
    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
  3203
    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
  3204
    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
  3205
    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
  3206
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3207
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3208
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
  3209
    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
  3210
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3211
    set n [gets $gdtf line]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3212
    if {$n < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3213
	if {![eof $gdtf]} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3214
	close $gdtf
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3215
	set treediffs($ids) $treediff
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3216
	unset treepending
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3217
	if {$ids != $diffids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3218
	    gettreediffs $diffids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3219
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3220
	    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
  3221
		contmergediff $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3222
	    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3223
		addtocflist $ids
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3224
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3225
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3226
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3227
    }
4741
4a84f7421692 Make hgk handle filenames with spaces (issue49)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4740
diff changeset
  3228
    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
  3229
    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
  3230
    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
  3231
    lappend treediff $file
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3232
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3233
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3234
proc getblobdiffs {ids} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3235
    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
  3236
    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
  3237
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3238
    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
  3239
    set p [lindex $ids 1]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3240
    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
  3241
    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
  3242
    if {[catch {set bdf [open $cmd r]} err]} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3243
	puts "error getting diffs: $err"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3244
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3245
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3246
    set diffinhdr 0
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3247
    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
  3248
    set blobdifffd($ids) $bdf
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3249
    set curdifftag Comments
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3250
    set curtagstart 0.0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3251
    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
  3252
    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
  3253
    set nextupdate [expr {[clock clicks -milliseconds] + 100}]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3254
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3255
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3256
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
  3257
    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
  3258
    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
  3259
    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
  3260
    global gaudydiff
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3261
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3262
    set n [gets $bdf line]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3263
    if {$n < 0} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3264
	if {[eof $bdf]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3265
	    close $bdf
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3266
	    if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3267
		$ctext tag add $curdifftag $curtagstart end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3268
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3269
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3270
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3271
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3272
    if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3273
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3274
    }
3940
a33ddd20105c hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents: 3093
diff changeset
  3275
    regsub -all "\r" $line "" line
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3276
    $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
  3277
    if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3278
	# start of a new file
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3279
	$ctext insert end "\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3280
	$ctext tag add $curdifftag $curtagstart end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3281
	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
  3282
	set header $newname
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3283
	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
  3284
	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
  3285
	if {$i >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3286
	    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
  3287
	    incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3288
	    $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
  3289
	    $ctext mark gravity fmark.$i left
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3290
	}
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3291
	if {$newname != $fname} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3292
	    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
  3293
	    if {$i >= 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3294
		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
  3295
		incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3296
		$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
  3297
		$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
  3298
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3299
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3300
	set curdifftag "f:$fname"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3301
	$ctext tag delete $curdifftag
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3302
	set l [expr {(78 - [string length $header]) / 2}]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3303
	set pad [string range "----------------------------------------" 1 $l]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3304
	$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
  3305
	set diffinhdr 1
9989
60cefb8b3c85 hgk: do not ignore ---/+++ lines in diff
Fabian Kreutz <project+hg@fabian-kreutz.de>
parents: 7776
diff changeset
  3306
    } elseif {[regexp {^(---|\+\+\+) } $line] && $diffinhdr} {
60cefb8b3c85 hgk: do not ignore ---/+++ lines in diff
Fabian Kreutz <project+hg@fabian-kreutz.de>
parents: 7776
diff changeset
  3307
	set diffinhdr 1
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3308
    } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3309
		   $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
  3310
	if {$gaudydiff} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3311
	    $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
  3312
	    $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
  3313
	    $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
  3314
	} else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3315
	    $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
  3316
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3317
	set diffinhdr 0
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3318
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3319
	set x [string range $line 0 0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3320
	if {$x == "-" || $x == "+"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3321
	    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
  3322
	    if {$gaudydiff} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3323
		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
  3324
	    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3325
	    $ctext insert end "$line\n" d$tag
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3326
	} elseif {$x == " "} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3327
	    if {$gaudydiff} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3328
		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
  3329
	    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3330
	    $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
  3331
	} elseif {$diffinhdr || $x == "\\"} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3332
	    # e.g. "\ No newline at end of file"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3333
	    $ctext insert end "$line\n" filesep
3940
a33ddd20105c hgk - fix CR issues on windows
"Andrei Vermel <avermel@mail.ru>"
parents: 3093
diff changeset
  3334
	} elseif  {$line != ""} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3335
	    # Something else we don't recognize
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3336
	    if {$curdifftag != "Comments"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3337
		$ctext insert end "\n"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3338
		$ctext tag add $curdifftag $curtagstart end
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3339
		set curtagstart [$ctext index "end - 1c"]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3340
		set curdifftag Comments
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3341
	    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3342
	    $ctext insert end "$line\n" filesep
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3343
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3344
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3345
    $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
  3346
    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
  3347
	incr nextupdate 100
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3348
	fileevent $bdf readable {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3349
	update
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3350
	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
  3351
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3352
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3353
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3354
proc nextfile {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3355
    global difffilestart ctext
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3356
    set here [$ctext index @0,0]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3357
    for {set i 0} {[info exists difffilestart($i)]} {incr i} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3358
	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
  3359
	    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
  3360
		|| [$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
  3361
		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
  3362
	    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3363
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3364
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3365
    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
  3366
	$ctext yview $pos
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3367
    }
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3368
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3369
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3370
proc listboxsel {} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3371
    global ctext cflist currentid
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3372
    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
  3373
    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
  3374
    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
  3375
    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
  3376
    catch {$ctext yview fmark.$first}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3377
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3378
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3379
proc setcoords {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3380
    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
  3381
    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
  3382
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3383
    set linespc [font metrics $mainfont -linespace]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3384
    set charspc [font measure $mainfont "m"]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3385
    set canvy0 [expr 3 + 0.5 * $linespc]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3386
    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
  3387
    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
  3388
    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
  3389
    set xspc2 $linespc
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3390
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3391
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3392
proc redisplay {} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3393
    global stopped redisplaying phase
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3394
    if {$stopped > 1} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3395
    if {$phase == "getcommits"} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3396
    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
  3397
    if {$phase == "drawgraph" || $phase == "incrdraw"} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3398
	set stopped 1
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3399
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3400
	drawgraph
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3401
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3402
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3403
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3404
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
  3405
    global mainfont namefont textfont ctext canv phase
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  3406
    global stopped entries curidfont
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3407
    unmarkmatches
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3408
    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  3409
    set curidfont [lreplace $curidfont 1 1 [expr {[lindex $curidfont 1] + $inc}]]
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3410
    set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3411
    set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3412
    setcoords
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3413
    $ctext conf -font $textfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3414
    $ctext tag conf filesep -font [concat $textfont bold]
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3415
    foreach e $entries {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3416
	$e conf -font $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3417
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3418
    if {$phase == "getcommits"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3419
	$canv itemconf textitems -font $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3420
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3421
    redisplay
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3422
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3423
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3424
proc clearsha1 {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3425
    global sha1entry sha1string
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3426
    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
  3427
	$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
  3428
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3429
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3430
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3431
proc sha1change {n1 n2 op} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3432
    global sha1string currentid sha1but
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3433
    if {$sha1string == {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3434
	|| ([info exists currentid] && $sha1string == $currentid)} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3435
	set state disabled
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3436
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3437
	set state normal
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3438
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3439
    if {[$sha1but cget -state] == $state} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3440
    if {$state == "normal"} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3441
	$sha1but conf -state normal -relief raised -text "Goto: "
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3442
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3443
	$sha1but conf -state disabled -relief flat -text "SHA1 ID: "
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3444
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3445
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3446
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3447
proc gotocommit {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3448
    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
  3449
    global lineid numcommits
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3450
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3451
    if {$sha1string == {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3452
	|| ([info exists currentid] && $sha1string == $currentid)} return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3453
    if {[info exists tagids($sha1string)]} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3454
	set id $tagids($sha1string)
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3455
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3456
	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
  3457
	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
  3458
	    set matches {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3459
	    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
  3460
		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
  3461
		    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
  3462
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3463
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3464
	    if {$matches ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3465
		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
  3466
		    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
  3467
		    return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3468
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3469
		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
  3470
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3471
	}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3472
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3473
    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
  3474
	selectline $idline($id) 1
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3475
	return
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3476
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3477
    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3478
	set type "SHA1 id"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3479
    } else {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3480
	set type "Tag"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3481
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3482
    error_popup "$type $sha1string is not known"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3483
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  3484
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3485
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
  3486
    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
  3487
    global commitinfo canv
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3488
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3489
    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
  3490
    set hoverx $x
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3491
    set hovery $y
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3492
    set hoverid $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3493
    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
  3494
	after cancel $hovertimer
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
    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
  3497
    $canv delete hover
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
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3500
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
  3501
    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
  3502
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3503
    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
  3504
	set hoverx $x
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3505
	set hovery $y
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3506
	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
  3507
	    after cancel $hovertimer
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3508
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3509
	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
  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
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3513
proc lineleave {id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3514
    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
  3515
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3516
    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
  3517
	$canv delete hover
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3518
	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
  3519
	    after cancel $hovertimer
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3520
	    unset hovertimer
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3521
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3522
	unset hoverid
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
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3526
proc linehover {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3527
    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
  3528
    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
  3529
    global commitinfo mainfont
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
    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
  3532
    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
  3533
    if {$ymax == {}} return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3534
    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
  3535
    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
  3536
    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
  3537
    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
  3538
    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
  3539
    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
  3540
    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
  3541
    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
  3542
	       -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
  3543
    $canv raise $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3544
    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
  3545
    $canv raise $t
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3546
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3547
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3548
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
  3549
    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
  3550
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3551
    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
  3552
    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
  3553
	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
  3554
	    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
  3555
		return "up"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3556
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3557
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3558
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3559
    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
  3560
	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
  3561
	    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
  3562
	    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
  3563
	    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
  3564
		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
  3565
		    return "up"
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3566
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3567
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3568
	    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
  3569
		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
  3570
		    return "down"
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
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3573
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3574
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3575
    return {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3576
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3577
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3578
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
  3579
    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
  3580
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3581
    set yt {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3582
    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
  3583
	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
  3584
	    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
  3585
	    if {$y1 > $y} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3586
		set yt $y1
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
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3589
	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
  3590
	    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
  3591
		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
  3592
		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
  3593
		    set yt $y1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3594
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3595
	    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3596
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3597
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3598
	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
  3599
	    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
  3600
		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
  3601
		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
  3602
		    set yt $y1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3603
		}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3604
	    }
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
    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
  3608
    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
  3609
    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
  3610
    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
  3611
    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
  3612
    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
  3613
    if {$yfrac < 0} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3614
	set yfrac 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3615
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3616
    $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
  3617
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3618
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3619
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
  3620
    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
  3621
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3622
    unmarkmatches
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3623
    unselectline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3624
    normalline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3625
    $canv delete hover
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3626
    # 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
  3627
    drawlines $id 1
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3628
    set thickerline $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3629
    if {$isnew} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3630
	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
  3631
	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
  3632
	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
  3633
	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
  3634
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3635
    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
  3636
    if {$dirn ne {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3637
	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
  3638
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3639
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3640
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3641
    if {$isnew} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3642
	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
  3643
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3644
    # 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
  3645
    $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
  3646
    $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
  3647
    $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
  3648
    $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
  3649
    $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
  3650
    $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
  3651
    $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
  3652
    $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
  3653
    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
  3654
    $ctext insert end "\n\t[lindex $info 0]\n"
18802
814498f80d7d hgk: reformat changsets fields
Andrew Shadura <bugzilla@tut.by>
parents: 18801
diff changeset
  3655
    $ctext insert end "\tUser:\t[lindex $info 1]\n"
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3656
    $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
  3657
    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
  3658
	$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
  3659
	set i 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3660
	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
  3661
	    incr i
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3662
	    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
  3663
	    $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
  3664
	    $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
  3665
	    $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
  3666
	    $ctext insert end "\n\t[lindex $info 0]"
18802
814498f80d7d hgk: reformat changsets fields
Andrew Shadura <bugzilla@tut.by>
parents: 18801
diff changeset
  3667
	    $ctext insert end "\n\tUser:\t[lindex $info 1]"
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3668
	    $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
  3669
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3670
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3671
    $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
  3672
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3673
    $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
  3674
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3675
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3676
proc normalline {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3677
    global thickerline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3678
    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
  3679
	drawlines $thickerline 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3680
	unset thickerline
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
}
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
proc selbyid {id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3685
    global idline
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3686
    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
  3687
	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
  3688
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3689
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3690
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3691
proc mstime {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3692
    global startmstime
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3693
    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
  3694
	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
  3695
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3696
    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
  3697
}
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
proc rowmenu {x y id} {
5394
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3700
    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
  3701
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3702
    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
  3703
	set state disabled
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3704
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3705
	set state normal
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
    $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
  3708
    $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
  3709
    $rowctxmenu entryconfigure 2 -state $state
5394
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3710
    if { $hgvdiff ne "" } {
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3711
	$rowctxmenu entryconfigure 6 -state $state
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  3712
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3713
    set rowmenuid $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3714
    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
  3715
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3716
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3717
proc diffvssel {dirn} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3718
    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
  3719
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3720
    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
  3721
    if {$dirn} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3722
	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
  3723
	set newid $rowmenuid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3724
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3725
	set oldid $rowmenuid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3726
	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
  3727
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3728
    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
  3729
    doseldiff $oldid $newid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3730
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3731
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3732
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
  3733
    global ctext cflist
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3734
    global commitinfo
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
    $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
  3739
    $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
  3740
    $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
  3741
    $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
  3742
    $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
  3743
    $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
  3744
    $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
  3745
    $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
  3746
    $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
  3747
    $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
  3748
    $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
  3749
    $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
  3750
    $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
  3751
    $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
  3752
    $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
  3753
    $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
  3754
    $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
  3755
    $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
  3756
    $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
  3757
    $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
  3758
    $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
  3759
    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
  3760
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3761
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3762
proc mkpatch {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3763
    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
  3764
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3765
    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
  3766
    set oldid $currentid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3767
    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
  3768
    set newid $rowmenuid
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3769
    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
  3770
    set top .patch
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3771
    set patchtop $top
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3772
    catch {destroy $top}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3773
    toplevel $top
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3774
    ttk::label $top.from -text "From:"
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3775
    ttk::entry $top.fromsha1 -width 40
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3776
    $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
  3777
    $top.fromsha1 conf -state readonly
18806
932f5d3587c9 hgk: in popups, replace labels with window titles
Andrew Shadura <bugzilla@tut.by>
parents: 18805
diff changeset
  3778
    grid $top.from $top.fromsha1 -sticky w -pady {10 0}
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3779
    ttk::entry $top.fromhead -width 60
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3780
    $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
  3781
    $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
  3782
    grid x $top.fromhead -sticky w
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3783
    ttk::label $top.to -text "To:"
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3784
    ttk::entry $top.tosha1 -width 40
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3785
    $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
  3786
    $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
  3787
    grid $top.to $top.tosha1 -sticky w
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3788
    ttk::entry $top.tohead -width 60
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3789
    $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
  3790
    $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
  3791
    grid x $top.tohead -sticky w
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3792
    ttk::button $top.rev -text "Reverse" -command mkpatchrev
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3793
    grid $top.rev x -pady 10
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3794
    ttk::label $top.flab -text "Output file:"
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3795
    ttk::entry $top.fname -width 60
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3796
    $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
  3797
    incr patchnum
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3798
    grid $top.flab $top.fname -sticky w
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3799
    ttk::frame $top.buts
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3800
    ttk::button $top.buts.gen -text "Generate" -command mkpatchgo
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3801
    ttk::button $top.buts.can -text "Cancel" -command mkpatchcan
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3802
    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
  3803
    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
  3804
    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
  3805
    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
  3806
    focus $top.fname
18804
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
  3807
    popupify $top
18806
932f5d3587c9 hgk: in popups, replace labels with window titles
Andrew Shadura <bugzilla@tut.by>
parents: 18805
diff changeset
  3808
    wm title $top "Generate a patch"
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3809
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3810
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3811
proc mkpatchrev {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3812
    global patchtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3813
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3814
    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
  3815
    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
  3816
    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
  3817
    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
  3818
    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
  3819
	    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
  3820
	$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
  3821
	$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
  3822
	$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
  3823
	$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
  3824
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3825
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3826
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3827
proc mkpatchgo {} {
4688
39001f4b7d99 hgk: Use $HG instead of hg (see 849f011dbf79)
Thomas Arendsen Hein <thomas@intevation.de>
parents: 4502
diff changeset
  3828
    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
  3829
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3830
    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
  3831
    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
  3832
    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
  3833
    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
  3834
	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
  3835
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3836
    catch {destroy $patchtop}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3837
    unset patchtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3838
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3839
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3840
proc mkpatchcan {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3841
    global patchtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3842
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3843
    catch {destroy $patchtop}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3844
    unset patchtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3845
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3846
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3847
proc mktag {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3848
    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
  3849
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3850
    set top .maketag
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3851
    set mktagtop $top
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3852
    catch {destroy $top}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3853
    toplevel $top
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3854
    ttk::label $top.id -text "ID:"
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3855
    ttk::entry $top.sha1 -width 40
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3856
    $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
  3857
    $top.sha1 conf -state readonly
18806
932f5d3587c9 hgk: in popups, replace labels with window titles
Andrew Shadura <bugzilla@tut.by>
parents: 18805
diff changeset
  3858
    grid $top.id $top.sha1 -sticky w -pady {10 0}
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3859
    ttk::entry $top.head -width 60
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3860
    $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
  3861
    $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
  3862
    grid x $top.head -sticky w
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3863
    ttk::label $top.tlab -text "Tag name:"
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3864
    ttk::entry $top.tag -width 60
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3865
    grid $top.tlab $top.tag -sticky w
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3866
    ttk::frame $top.buts
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3867
    ttk::button $top.buts.gen -text "Create" -command mktaggo
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3868
    ttk::button $top.buts.can -text "Cancel" -command mktagcan
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3869
    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
  3870
    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
  3871
    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
  3872
    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
  3873
    focus $top.tag
18804
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
  3874
    popupify $top
18806
932f5d3587c9 hgk: in popups, replace labels with window titles
Andrew Shadura <bugzilla@tut.by>
parents: 18805
diff changeset
  3875
    wm title $top "Create a tag"
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3876
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3877
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3878
proc domktag {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3879
    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
  3880
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3881
    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
  3882
    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
  3883
    if {$tag == {}} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3884
	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
  3885
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3886
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3887
    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
  3888
	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
  3889
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3890
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3891
    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
  3892
	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
  3893
    } err]} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3894
	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
  3895
	return
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3896
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3897
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3898
    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
  3899
    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
  3900
    redrawtags $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3901
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3902
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3903
proc redrawtags {id} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3904
    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
  3905
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3906
    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
  3907
    $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
  3908
    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
  3909
    $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
  3910
    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
  3911
	selectline $selectedline 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3912
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3913
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3914
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3915
proc mktagcan {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3916
    global mktagtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3917
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3918
    catch {destroy $mktagtop}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3919
    unset mktagtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3920
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3921
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3922
proc mktaggo {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3923
    domktag
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3924
    mktagcan
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3925
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3926
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3927
proc writecommit {} {
20935
70f9a5d8c06f hgk: use hg export to write commits
Andrew Shadura <andrew@shadura.me>
parents: 20934
diff changeset
  3928
    global rowmenuid wrcomtop commitinfo
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3929
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3930
    set top .writecommit
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3931
    set wrcomtop $top
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3932
    catch {destroy $top}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3933
    toplevel $top
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3934
    ttk::label $top.id -text "ID:"
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3935
    ttk::entry $top.sha1 -width 40
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3936
    $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
  3937
    $top.sha1 conf -state readonly
18806
932f5d3587c9 hgk: in popups, replace labels with window titles
Andrew Shadura <bugzilla@tut.by>
parents: 18805
diff changeset
  3938
    grid $top.id $top.sha1 -sticky w -pady {10 0}
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3939
    ttk::entry $top.head -width 60
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3940
    $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
  3941
    $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
  3942
    grid x $top.head -sticky w
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3943
    ttk::label $top.flab -text "Output file:"
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3944
    ttk::entry $top.fname -width 60
20934
777daa412e56 hgk: add .diff extension when exporting commits
Andrew Shadura <andrew@shadura.me>
parents: 20764
diff changeset
  3945
    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6].diff"]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3946
    grid $top.flab $top.fname -sticky w
17958
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3947
    ttk::frame $top.buts
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3948
    ttk::button $top.buts.gen -text "Write" -command wrcomgo
0f93bbe8deb7 hgk: use Ttk instead of plain Tk
Andrew Shadura <bugzilla@tut.by>
parents: 13463
diff changeset
  3949
    ttk::button $top.buts.can -text "Cancel" -command wrcomcan
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3950
    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
  3951
    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
  3952
    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
  3953
    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
  3954
    focus $top.fname
18804
870505ec3e56 hgk: fix pop-up windows
Andrew Shadura <bugzilla@tut.by>
parents: 18803
diff changeset
  3955
    popupify $top
18806
932f5d3587c9 hgk: in popups, replace labels with window titles
Andrew Shadura <bugzilla@tut.by>
parents: 18805
diff changeset
  3956
    wm title $top "Write commit to a file"
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3957
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3958
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3959
proc wrcomgo {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3960
    global wrcomtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3961
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3962
    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
  3963
    set fname [$wrcomtop.fname get]
20935
70f9a5d8c06f hgk: use hg export to write commits
Andrew Shadura <andrew@shadura.me>
parents: 20934
diff changeset
  3964
    if {[catch {exec $::env(HG) --config ui.report_untrusted=false export --git -o [string map {% %%} $fname] $id} err]} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3965
	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
  3966
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3967
    catch {destroy $wrcomtop}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3968
    unset wrcomtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3969
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3970
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3971
proc wrcomcan {} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3972
    global wrcomtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3973
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3974
    catch {destroy $wrcomtop}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3975
    unset wrcomtop
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3976
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3977
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3978
proc listrefs {id} {
13461
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  3979
    global idtags idheads idotherrefs idbookmarks
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  3980
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  3981
    set w {}
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  3982
    if {[info exists idbookmarks($id)]} {
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  3983
	set w $idbookmarks($id)
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  3984
    }
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3985
    set x {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3986
    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
  3987
	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
  3988
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3989
    set y {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3990
    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
  3991
	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
  3992
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3993
    set z {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3994
    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
  3995
	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
  3996
    }
13461
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  3997
    return [list $w $x $y $z]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3998
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  3999
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4000
proc rereadrefs {} {
13461
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  4001
    global idbookmarks idtags idheads idotherrefs
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  4002
    global bookmarkids tagids headids otherrefids
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4003
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4004
    set refids [concat [array names idtags] \
13461
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  4005
		    [array names idheads] [array names idotherrefs] \
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  4006
		    [array names idbookmarks]]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4007
    foreach id $refids {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4008
	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
  4009
	    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
  4010
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4011
    }
13461
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  4012
    foreach v {tagids idtags headids idheads otherrefids idotherrefs \
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  4013
        bookmarkids idbookmarks} {
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4014
	catch {unset $v}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4015
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4016
    readrefs
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4017
    set refids [lsort -unique [concat $refids [array names idtags] \
13461
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  4018
			[array names idheads] [array names idotherrefs] \
81af2040b586 hgk: read bookmarks
David Soria Parra <dsp@php.net>
parents: 13380
diff changeset
  4019
			[array names idbookmarks]]]
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4020
    foreach id $refids {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4021
	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
  4022
	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
  4023
	    redrawtags $id
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4024
	}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4025
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4026
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4027
5394
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4028
proc vdiff {withparent} {
5417
b8872655f951 hgk: allow any extdiff command for visual diff
TK Soh <teekaysoh@yahoo.com>
parents: 5395
diff changeset
  4029
    global env rowmenuid selectedline lineid hgvdiff
5394
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4030
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4031
    if {![info exists rowmenuid]} return
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4032
    set curid $rowmenuid
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4033
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4034
    if {$withparent} {
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4035
	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
  4036
	set firstparent [lindex [split $parents "\n"] 0]
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4037
	set otherid $firstparent
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4038
    } else {
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4039
	if {![info exists selectedline]} return
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4040
	set otherid $lineid($selectedline)
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4041
    }
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4042
    set range "$otherid:$curid"
5417
b8872655f951 hgk: allow any extdiff command for visual diff
TK Soh <teekaysoh@yahoo.com>
parents: 5395
diff changeset
  4043
    if {[catch {exec $env(HG) --config ui.report_untrusted=false $hgvdiff -r $range} err]} {
5394
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4044
        # Ignore errors, this is just visualization
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4045
    }
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4046
}
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4047
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4048
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
  4049
    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
  4050
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4051
    if {$isnew} {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4052
	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
  4053
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4054
    $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
  4055
    $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
  4056
    set linknum 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4057
    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
  4058
	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
  4059
    } else {
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4060
	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
  4061
    }
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4062
    appendwithlinks $text
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4063
    $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
  4064
    $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
  4065
}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4066
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4067
proc doquit {} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4068
    global stopped
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4069
    set stopped 100
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4070
    destroy .
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4071
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4072
5393
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  4073
proc getconfig {} {
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  4074
    global env
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  4075
    set config {}
24514
d01c767d8753 hgk: remove no longer needed debug-config command
Andrew Shadura <andrew@shadura.me>
parents: 24513
diff changeset
  4076
d01c767d8753 hgk: remove no longer needed debug-config command
Andrew Shadura <andrew@shadura.me>
parents: 24513
diff changeset
  4077
    set lines [exec $env(HG) debugconfig]
d01c767d8753 hgk: remove no longer needed debug-config command
Andrew Shadura <andrew@shadura.me>
parents: 24513
diff changeset
  4078
    foreach line [split $lines \n] {
d01c767d8753 hgk: remove no longer needed debug-config command
Andrew Shadura <andrew@shadura.me>
parents: 24513
diff changeset
  4079
	set line [string trimright $line \r]
d01c767d8753 hgk: remove no longer needed debug-config command
Andrew Shadura <andrew@shadura.me>
parents: 24513
diff changeset
  4080
	if {[string match hgk.* $line]} {
d01c767d8753 hgk: remove no longer needed debug-config command
Andrew Shadura <andrew@shadura.me>
parents: 24513
diff changeset
  4081
	    regexp {(.*)=(.*)} $line - k v
d01c767d8753 hgk: remove no longer needed debug-config command
Andrew Shadura <andrew@shadura.me>
parents: 24513
diff changeset
  4082
	    lappend config $k $v
d01c767d8753 hgk: remove no longer needed debug-config command
Andrew Shadura <andrew@shadura.me>
parents: 24513
diff changeset
  4083
	}
5393
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  4084
    }
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  4085
    return $config
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  4086
}
c2ad1890fc53 hgk: add debug-config command to pass configuration options
Patrick Mezard <pmezard@gmail.com>
parents: 5392
diff changeset
  4087
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4088
# defaults...
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4089
set datemode 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4090
set boldnames 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4091
set diffopts "-U 5 -p"
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4092
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4093
set mainfont {Helvetica 9}
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  4094
set curidfont {}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4095
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
  4096
set findmergefiles 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4097
set gaudydiff 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4098
set maxgraphpct 50
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4099
set maxwidth 16
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4100
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4101
set colors {green red blue magenta darkgrey brown orange}
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  4102
set authorcolors {
5662
ab5a455cb67c hgk: add black and blue as preferred colors
Steve Borho <steve@borho.org>
parents: 5506
diff changeset
  4103
    black blue deeppink mediumorchid blue burlywood4 goldenrod slateblue red2 navy dimgrey
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  4104
}
7738
db366ec8d0a4 hgk: Add background colour setting
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7039
diff changeset
  4105
set bgcolor white
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4106
7745
8bfe47e726fe hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7738
diff changeset
  4107
# This color should probably be some system color (provided by tk),
8bfe47e726fe hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7738
diff changeset
  4108
# but as the bgcolor has always been set to white, I choose to ignore
8bfe47e726fe hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7738
diff changeset
  4109
set fgcolor black
7746
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
  4110
set diffaddcolor "#00a000"
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
  4111
set diffremcolor red
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
  4112
set diffmerge1color red
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
  4113
set diffmerge2color blue
59815cef38f0 hgk: added colour settings for different colours in diff view
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7745
diff changeset
  4114
set hunksepcolor blue
7745
8bfe47e726fe hgk: added setting of foreground colour
Robert Bauck Hamar <r.b.hamar@usit.uio.no>
parents: 7738
diff changeset
  4115
5506
be20a42f27a1 hgk: change config file from .gitk to .hgk
bdowning@lavos.net
parents: 5464
diff changeset
  4116
catch {source ~/.hgk}
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4117
5464
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  4118
if {$curidfont == ""} {  # initialize late based on current mainfont
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  4119
    set curidfont "$mainfont bold italic underline"
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  4120
}
7dafd9ab3979 hgk: colorize commits by authors
Georg.Koltermann@mscsoftware.com
parents: 5417
diff changeset
  4121
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4122
set namefont $mainfont
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4123
if {$boldnames} {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4124
    lappend namefont bold
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4125
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4126
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4127
set revtreeargs {}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4128
foreach arg $argv {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4129
    switch -regexp -- $arg {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4130
	"^$" { }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4131
	"^-b" { set boldnames 1 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4132
	"^-d" { set datemode 1 }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4133
	default {
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4134
	    lappend revtreeargs $arg
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4135
	}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4136
    }
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4137
}
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4138
1240
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4139
set history {}
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4140
set historyindex 0
cc756ffd4d04 Convert hgk to use the hgit extension, and upate to the latest gitk
mason@suse.com
parents: 283
diff changeset
  4141
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4142
set stopped 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4143
set redisplaying 0
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4144
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
  4145
set patchnum 0
5394
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4146
24514
d01c767d8753 hgk: remove no longer needed debug-config command
Andrew Shadura <andrew@shadura.me>
parents: 24513
diff changeset
  4147
set config(hgk.vdiff) ""
5394
0ad0e97345eb hgk: add context menu visual diff action
Patrick Mezard <pmezard@gmail.com>
parents: 5393
diff changeset
  4148
array set config [getconfig]
24514
d01c767d8753 hgk: remove no longer needed debug-config command
Andrew Shadura <andrew@shadura.me>
parents: 24513
diff changeset
  4149
set hgvdiff $config(hgk.vdiff)
267
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4150
setcoords
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4151
makewindow
497aa6d276d2 Initial import of hgit and hgk
mpm@selenic.com
parents:
diff changeset
  4152
readrefs
5284
f8c36b215281 hgk: add repo root to window title
Steve Borho <steve@borho.org>
parents: 5143
diff changeset
  4153
set hgroot [exec $env(HG) root]
f8c36b215281 hgk: add repo root to window title
Steve Borho <steve@borho.org>
parents: 5143
diff changeset
  4154
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
  4155
getcommits $revtreeargs