Eskil

2018-05-13
 Adjustments to fourway UI.

Released 2.8.2

2018-05-13
 Bumped revision to 2.8.2
 Fixed bug in Fossil handling. Rev -1 did not work.

2018-05-12

    set balloon(pending) 0
    set balloon(created) 0
    set balloon(id) ""
    namespace export addBalloon
}

# Do some simple formatting, to be able to have cleaner text in source
proc psballoon::Fmt {msg} {
    # Remove any newlines.
    set msg [regsub -all "\n" $msg " "]
    # Remove multiple whitespace
    set msg [regsub -all {\s+} $msg " "]
    set msg [string trim $msg]
    # Any explicitly requested newlines?
    set msg [regsub -all {\\n\s*} $msg "\n"]
    # Further line breaks by length?
    set lines {}
    foreach line [split $msg \n] {
        while {[string length $line] > 80} {
            # There should be no path through this loop that does not
            # shorten $line
            set ix [string last " " $line 80]
            if {$ix < 0} {
                set ix [string first " " $line]
                if {$ix < 0} {
                    # Just cut at 80
                    set ix 80
                }
            }
                
            if {$ix == 0} {
                set line [string trim $line]
            } else {
                lappend lines [string range $line 0 $ix-1]
                set line [string range $line $ix+1 end]
            }
        }
        lappend lines $line
    }
    set msg [join $lines \n]
    return $msg
}

proc psballoon::addBalloon {w args} {
    variable balloon

    set msg [lindex $args end]
    set args [lrange $args 0 end-1]

    # Request for formatting
    if {"-fmt" in $args && $msg ne ""} {
        set msg [Fmt $msg]
    }
    
    set c [winfo class $w]
    if {$msg == "" && $c != "Listbox" && $c != "Label"} {
        error "Missing message to balloon for $w ($c)"
    }
    set balloon(msg,$w) $msg
    bind $w <Enter> {
        set ::psballoon::balloon(pending) 1

    }
    if {[winfo exists .balloon] == 1} {
        destroy .balloon
    }
    set balloon(created) 0
    set balloon(pending) 0
}

# Measure display width needed for a text with line breaks
proc psballoon::Measure {font txt} {
    set len 0
    foreach line [split $txt \n] {
        set lw [font measure $font $line]
        if {$lw > $len} {
            set len $lw
        }
    }
    return $len
}

proc psballoon::createBalloon {w mx my} {
    variable balloon
    if {$balloon(created) == 0} {
        # Figure out widget's font
        if {[catch {set font [$w cget -font]}]} {
            set font [ttk::style lookup [winfo class $w] -font]

                Listbox {
                    set i [$w index @$mx,$my]
                    set msg [$w get $i]
                    foreach {ix iy iw ih} [$w bbox $i] {break}
                }
                Label {
                    set msg [$w cget -text]
		    set iw [Measure $font $msg]
                }
            }
            #Don't create a balloon if the text is fully visible.
            set create [expr {$iw > $ww - 8}]
        } else {
            if {[string index $msg 0] eq "\["} {
                set msg [subst -novariables -nobackslashes $msg]
            }
	    set iw [Measure $font $msg]
	}
	if {$create} {
            set x [expr {[winfo rootx $w] + $ix}]
            set y [expr {[winfo rooty $w] + $iy + $ih + 2}]
            if {$x + $iw + 8 > [winfo screenwidth $w]} {
                set x [expr {[winfo screenwidth $w] - $iw - 8}]
            }

        # Four files, with optional revision
        set fields {base1 change1 base2 change2}
    
        ttk::label $win.l1 -text "Base 1"
        ttk::label $win.l2 -text "Changed 1"
        ttk::label $win.l3 -text "Base 2"
        ttk::label $win.l4 -text "Changed 2"
        set txt1 {
            First diff is made from Base 1 to Changed 1.\n
            If a file is empty and have a revision, the other file name is used.
        }
        addBalloon $win.l1 -fmt $txt1
        addBalloon $win.l2 -fmt txt1
        set txt2 [string map {1 2 First Second} $txt1]
        addBalloon $win.l3 -fmt $txt2
        addBalloon $win.l4 -fmt $txt2

        ttk::label $win.el -text "File path"
        ttk::label $win.rl -text "Rev"
        addBalloon $win.rl -fmt {
            If you want to use a revisioned controlled file
            instead of the one on disk, add a revision here.
            E.g. 0 can be used for latest commited revision.
        }

        set n 0
        foreach field $fields {
            incr n
            ttk::entryX $win.e$n -width 60 -textvariable [myvar files($field)]
            ttk::button $win.b$n -text "Browse" \
                    -command [mymethod browseFile $field]
            ttk::entryX $win.r$n -width 8 -textvariable  [myvar revs($field)]
        }

        ttk::button $win.bd -text "Diff" -command [mymethod doFourWayDiff] \
                -underline 0 -width 8
        bind $win <Alt-d> [list $win.bd invoke]

        grid x       $win.el x       $win.rl -sticky w  -padx 3 -pady 3
        grid $win.l1 $win.e1 $win.b1 $win.r1 -sticky we -padx 3 -pady 3
        grid $win.l2 $win.e2 $win.b2 $win.r2 -sticky we -padx 3 -pady 3
        grid $win.l3 $win.e3 $win.b3 $win.r3 -sticky we -padx 3 -pady {10 3}
        grid $win.l4 $win.e4 $win.b4 $win.r4 -sticky we -padx 3 -pady 3
        grid $win.bd -       -                  -padx 3 -pady {10 3}

        grid columnconfigure $win $win.el -weight 1
        
        # Set up file dropping in entry windows if TkDnd is available
        if {![catch {package require tkdnd}]} {
            dnd bindtarget $win    text/uri-list <Drop> "[mymethod fileDrop any    ] %D"
            dnd bindtarget $win.e1 text/uri-list <Drop> "[mymethod fileDrop base1  ] %D"
            dnd bindtarget $win.e2 text/uri-list <Drop> "[mymethod fileDrop change1] %D"
            dnd bindtarget $win.e3 text/uri-list <Drop> "[mymethod fileDrop base2  ] %D"
            dnd bindtarget $win.e4 text/uri-list <Drop> "[mymethod fileDrop change2] %D"