#----------------------------------------------------------------------
#  Eskil, Printing
#
#  Copyright (c) 1998-2005, Peter Spjuth  (peter.spjuth@gmail.com)
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; see the file COPYING.  If not, write to
#  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
#  Boston, MA 02111-1307, USA.
#
#----------------------------------------------------------------------
# $Revision$
#----------------------------------------------------------------------

# Format a line number for printing
# It will always be maxlen chars wide.
proc FormatLineno {lineno maxlen} {
    if {[string is integer -strict $lineno]} {
        set res [format "%d: " $lineno]
    } else {
        # Non-numerical linenumbers might turn up in some cases
        set res $lineno
        if {[string length $res] > $maxlen} {
            set res [string range $res 0 [- $maxlen 1]]
        }
    }
    if {[string length $res] < $maxlen} {
        set res [format "%*s" $maxlen $res]
    }
    return $res
}

# Process the line numbers from the line number widget into a list
# of "linestarters"
proc ProcessLineno {W maxlen} {
    set tdump [$W dump -tag -text 1.0 end]
    set tag ""
    set line ""
    set lines {}
    foreach {key value index} $tdump {
        if {$key eq "tagon"} {
            if {$value eq "change" || [string match "new*" $value]} {
                set tag $value
            }
        } elseif {$key eq "tagoff"} {
            if {$value eq "change" || [string match "new*" $value]} {
                set tag ""
            }
        } elseif {$key eq "text"} {
            append line $value
            # Collect until end of line
            if {[string index $value end] eq "\n"} {
                # Clean everything but the line number
                set line [string trim [string trim $line] :]
                if {$line eq ""} {
                    lappend lines {}
                } else {
                    set formatline [FormatLineno $line $maxlen]
                    lappend lines [list $formatline $tag]
                }
                set line ""
            }
        }
    }
    return $lines
}

# Prepare a text block for printing
# Index denotes where in the text widget this text starts. It is used to get
# tab expansion right.
proc FixTextBlock {text index} {
    # Remove any form feed
    set text [string map {\f {}} $text]

    # Extract column number from index
    regexp {\d+\.(\d+)} $index -> index

    # Expand tabs to 8 chars
    while 1 {
        set i [string first \t $text]
        if {$i == -1} break
        set n [expr {(- $i - $index - 1) % 8 + 1}]
        set text [string replace $text $i $i [format %*s $n ""]]
    }
    return $text
}

# Find the lastnumber in a text widget
proc FindLastNumber {W} {
    set index [$W search -backwards -regexp {\d} end]
    if {$index eq ""} {
        # There where no numbers there, treat it like 0
        return 0
    }
    set line [$W get "$index linestart" "$index lineend"]
    #puts "X '$line' '$index'"
    regexp {\d+} $line number
    return $number
}

# Main print function
proc PrintDiffs {top {quiet 0}} {
    busyCursor $top
    update idletasks

    set lines1 {}
    set lines2 {}
    if {[info exists ::Pref(printCharsPerLine)]} {
        set wraplength $::Pref(printCharsPerLine)
    } else {
        set wraplength 85
    }

    set tdump1 [$::widgets($top,wDiff1) dump -tag -text 1.0 end]
    set tdump2 [$::widgets($top,wDiff2) dump -tag -text 1.0 end]

    # Figure out how many chars are needed for line numbers
    set len1 [string length [FindLastNumber $::widgets($top,wLine1)]]
    set len2 [string length [FindLastNumber $::widgets($top,wLine2)]]
    # Find maximum value (at least 3)
    set maxlen [lindex [lsort -integer [list 3 $len1 $len2]] end]
    # Add space for a colon and space
    incr maxlen 2

    set lineNo1 [ProcessLineno $::widgets($top,wLine1) $maxlen]
    set lineNo2 [ProcessLineno $::widgets($top,wLine2) $maxlen]

    set linepad [string repeat " " $maxlen]

    # Loop over left and right displays, collecting lines from each.
    # Line numbers and text are put together and lines are wrapped if needed.

    foreach tdump [list $tdump1 $tdump2] \
            lineName {lines1 lines2} wrapName {wrap1 wrap2} \
            lineNo [list $lineNo1 $lineNo2] {
        ##nagelfar variable lineName varName
        ##nagelfar variable wrapName varName
        set lines {}
        set wraps {}
        set line [lindex $lineNo 0]
        set newline 0
        set tag   {}
        set chars 0
        set wrapc 0
        foreach {key value index} $tdump {
            if {$key != "tagoff" && $newline == 1} {
                lappend lines $line
                lappend wraps $wrapc
                set newline 0
                set line [lindex $lineNo [llength $lines]]
                set chars 0
                set wrapc 0
            }
            switch $key {
                text {
                    set value [FixTextBlock $value $index]
                    if {[string index $value end] eq "\n"} {
                        set newline 1
                        set value [string trimright $value "\n"]
                    }
                    set len [string length $value]
                    while {$chars + $len > $wraplength} {
                        set wrap [expr {$wraplength - $chars}]
                        set val1 [string range $value 0 [- $wrap 1]]
                        set value [string range $value $wrap end]
                        # The newline has its own element to simplify finding
                        # it later.
                        lappend line $val1 $tag "\n" {} $linepad {}
                        set chars $maxlen
                        incr wrapc
                        set len [string length $value]
                    }
                    lappend line $value $tag
                    incr chars $len
                }
                tagon {
                    if {$value eq "change" || [string match "new*" $value]} {
                        set tag $value
                    }
                }
                tagoff {
                    if {$value eq "change" || [string match "new*" $value]} {
                        set tag {}
                    }
                }
            }
        }
        set $lineName $lines
        set $wrapName $wraps
    }

    # Go through both lists and put each wrapped line as one element.
    # Pad with empty lines as needed to accomodate for wrapped lines
    # in the other side.

    set wraplines1 {}
    set wraplines2 {}

    foreach l1 $lines1 l2 $lines2 w1 $wrap1 w2 $wrap2 {
        if {$w1 > 0} {
            while {[set i [lsearch $l1 "\n"]] >= 0} {
                lappend wraplines1 [lrange $l1 0 [- $i 1]]
                set l1 [lrange $l1 [+ $i 2] end]
            }
        }
        lappend wraplines1 $l1

        if {$w2 > 0} {
            while {[set i [lsearch $l2 "\n"]] >= 0} {
                lappend wraplines2 [lrange $l2 0 [- $i 1]]
                set l2 [lrange $l2 [+ $i 2] end]
            }
        }
        lappend wraplines2 $l2

        if {$w1 > $w2} {
            for {set t $w2} {$t < $w1} {incr t} {
                lappend wraplines2 {}
            }
        } elseif {$w2 > $w1} {
            for {set t $w1} {$t < $w2} {incr t} {
                lappend wraplines1 {}
            }
        }
    }

    PdfPrint $top $wraplength $maxlen $wraplines1 $wraplines2 $quiet

    # Finished

    normalCursor $top
}

proc PdfPrint {top cpl cpln wraplines1 wraplines2 {quiet 0}} {

    if {$::eskil($top,printFile) != ""} {
        set pdfFile $::eskil($top,printFile)
    } else {
        set pdfFile ~/eskil.pdf
    }

    if { ! [regexp {^(.*)( \(.*?\))$} $::eskil($top,leftLabel) -> lfile lrest]} {
        set lfile $::eskil($top,leftLabel)
        set lrest ""
    }
    set lfile [file tail $lfile]$lrest
    if { ! [regexp {^(.*)( \(.*?\))$} $::eskil($top,rightLabel) -> rfile rrest]} {
        set rfile $::eskil($top,rightLabel)
        set rrest ""
    }
    set rfile [file tail $rfile]$rrest

    set pdf [eskilprint %AUTO% -file $pdfFile -cpl $cpl -cpln $cpln \
                     -headleft $lfile -headright $rfile -headsize 10]
    set linesPerPage [$pdf getNLines]
    $pdf setTag change $::Pref(printColorChange)
    $pdf setTag new1   $::Pref(printColorNew1)
    $pdf setTag new2   $::Pref(printColorNew2)

    # Preprocess for page breaks in patch mode
    if {$::eskil($top,mode) eq "patch"} {
        set i 0
        set newWlines1 {}
        set newWlines2 {}
        foreach wline1 $wraplines1 wline2 $wraplines2 {
            if {[string match "-+-+-+-+-+-+-+-+-*" [lindex $wline1 0]]} {
                # This is a patch chunk header
                if {$i > 3} {
                    for {} {$i < $linesPerPage} {incr i} {
                        lappend newWlines1 {}
                        lappend newWlines2 {}
                    }
                    set i 0
                }
            }
            incr i
            if {$i >= $linesPerPage} {
                set i 0
            }
            lappend newWlines1 $wline1
            lappend newWlines2 $wline2
        }
        set wraplines1 $newWlines1
        set wraplines2 $newWlines2
    }

    set len1 [llength $wraplines1]
    set len2 [llength $wraplines2]

    set max [expr {$len1 > $len2 ? $len1 : $len2}]
    set npages [expr {($max + $linesPerPage - 1) / $linesPerPage}]
    $pdf configure -headnpages $npages

    set i1 0
    set i2 0

    while {$i1 < $len1 && $i2 < $len2} {
        $pdf newPage
        $pdf setHalf left
        for {set i 0} {$i < $linesPerPage && $i1 < $len1} {incr i ; incr i1} {
            $pdf drawTextLine [lindex $wraplines1 $i1]
            $pdf newLine
        }
        $pdf setHalf right
        for {set i 0} {$i < $linesPerPage && $i2 < $len2} {incr i ; incr i2} {
            $pdf drawTextLine [lindex $wraplines2 $i2]
            $pdf newLine
        }
    }
    $pdf endPrint

    if { ! $quiet} {
        tk_messageBox -title "Eskil Print" -parent $top \
                -message "Printed $npages pages to $pdfFile" -type ok
    }
}

# Count the length of a line during a text dump
proc AccumulateMax {top key value index} {
    set index [lindex [split $index "."] 1]
    set len [expr {[string length $value] + $index - 1}]
    if {$len > 0} {
        lappend ::eskil($top,currentCharsPerLine) $len
    }
}

# Count the longest line length in the current display
proc CountCharsPerLine {top} {
    set ::eskil($top,currentCharsPerLine) {}
    $::widgets($top,wDiff1) dump -text -command [list AccumulateMax $top] 1.0 end
    $::widgets($top,wDiff2) dump -text -command [list AccumulateMax $top] 1.0 end
    set ::eskil($top,currentCharsPerLine) \
            [lsort -integer $::eskil($top,currentCharsPerLine)]
    return [lindex $::eskil($top,currentCharsPerLine) end]
}

# In a sorted list of integers, figure out where val fits
# In 8.6 this could use lsearch -bisect
proc FindPercentile {lst val} {
    set len [llength $lst]
    # No elements, so all are covered in a way
    if {$len == 0} { return 100 }
    # Above range, so 100%
    if {[lindex $lst end] <= $val} { return 100 }
    # Under range, so 0%
    if {[lindex $lst 0] > $val} { return 0 }
    # Single element should not slip through...
    if {$len <= 1} { return 0 }

    set i [lsearch -integer -all $lst $val]
    set i [lindex $i end]
    if {$i >= 0} {
        return [expr {100 * $i / ($len - 1)}]
    }

    # To keep search down, just look at multiples of 1%
    set prev 0
    for {set t 0} {$t <= 100} {incr t} {
        set i [expr {$t * ($len - 1) / 100}]
        if {$val < [lindex $lst $i]} {
            return $prev
        }
        set prev $t
    }
    return 99
}

# Figure out reasonable selections for line length.
# 80 chars, and longest line used are always included.
proc CharsPerLineOptions {top} {
    set values [list 80]
    set cpl [CountCharsPerLine $top]
    if {$cpl ne "" && $cpl != 0} {
        lappend values $cpl
    }
    # Include previous selection
    if {[string is digit -strict $::Pref(printCharsPerLine)]} {
        lappend values $::Pref(printCharsPerLine)
    }
    # Include 90% if reasonable
    set len [llength $::eskil($top,currentCharsPerLine)]
    set cpl [lindex $::eskil($top,currentCharsPerLine) [expr {9*$len/10}]]
    if {$cpl ne "" && $cpl != 0} {
        lappend values $cpl
    }

    set values [lsort -unique -integer $values]
    set result {}
    foreach value $values {
        set p [FindPercentile $::eskil($top,currentCharsPerLine) $value]
        lappend result $value "$value ($p %)" \
                "$p % of the lines are within this line length"
    }
    return $result
}

proc BrowsePrintFileName {top entry} {
    set prev $::eskil($top,printFile)
    set dir [file dirname $prev]

    set apa [tk_getSaveFile -initialdir $dir -initialfile [file tail $prev] \
                     -parent [winfo toplevel $entry] -title "PDF file"]
    if {$apa eq ""} return
    # Auto-add .pdf
    if {[file extension $apa] eq ""} {
        append apa .pdf
    }

    set ::eskil($top,printFile) $apa
    $entry xview end
}

# Fix to give spinbox nicer appearance
proc MySpinBox {W args} {
    # Handle if ttk::spinbox is not there since it was introduced later
    if {[info commands ttk::spinbox] eq ""} {
        set cmd [list tk::spinbox $W]
    } else {
        set cmd [list ttk::spinbox $W]
        lappend cmd -command [list $W selection clear] -state readonly
    }
    lappend cmd {*}$args
    {*}$cmd
}

proc PrintTracePrefs {W args} {
    set ::Pref(printColorChange) \
            [list $::TmpPref(chr) $::TmpPref(chg) $::TmpPref(chb)]
    set ::Pref(printColorNew1) \
            [list $::TmpPref(n1r) $::TmpPref(n1g) $::TmpPref(n1b)]
    set ::Pref(printColorNew2) \
            [list $::TmpPref(n2r) $::TmpPref(n2g) $::TmpPref(n2b)]

    if  { ! [winfo exists $W.cf.l1e]} return
    foreach num {1 2 3} p {ch n1 n2} {
        set r [expr {int(255*$::TmpPref(${p}r))}]
        set g [expr {int(255*$::TmpPref(${p}g))}]
        set b [expr {int(255*$::TmpPref(${p}b))}]
        set col [format \#%02X%02X%02X $r $g $b]
        $W.cf.l${num}e configure -background $col
    }
}

# Create a print dialog for PDF.
proc doPrint {top {quiet 0}} {
    if {$quiet} {
        PrintDiffs $top 1
        return
    }

    set W $top.pr
    destroy $W
    ttk::toplevel $W -padx 3 -pady 3
    wm title $W "Print diffs to PDF"

    # Layout settings
    ttk::labelframe $W.lfs -text "Settings" -padding 3

    ttk::label $W.lfs.hsl -anchor w -text "Header Size"
    addBalloon $W.lfs.hsl "Font size for page header"
    MySpinBox $W.lfs.hss -textvariable ::Pref(printHeaderSize) \
            -from 5 -to 16 -width 3 -format %.0f

    ttk::label $W.lfs.cll -anchor w -text "Chars per line"
    addBalloon $W.lfs.cll "Font size is scaled to fit this"
    ttk::entryX $W.lfs.cle -textvariable ::Pref(printCharsPerLine) -width 4
    ttk::frame $W.lfs.clf

    set values [CharsPerLineOptions $top]
    foreach {value label balloon} $values {
        ttk::radiobutton $W.lfs.clf.$value -variable ::Pref(printCharsPerLine) \
            -value $value -text $label
        addBalloon $W.lfs.clf.$value $balloon
        pack $W.lfs.clf.$value -side left -padx 3 -pady 3
    }

    # Select paper size
    set paperlist [lsort -dictionary [pdf4tcl::getPaperSizeList]]
    ttk::label $W.lfs.psl -anchor w -text "Paper Size"
    ttk::combobox $W.lfs.psc -values $paperlist -textvariable ::Pref(printPaper) \
            -width 6 -state readonly

    grid $W.lfs.hsl $W.lfs.hss               -sticky we -padx 3 -pady 3
    grid $W.lfs.psl $W.lfs.psc               -sticky we -padx 3 -pady 3
    grid $W.lfs.cll $W.lfs.cle $W.lfs.clf -  -sticky we -padx 3 -pady 3
    grid columnconfigure $W.lfs 1 -weight 1

    # Color
    foreach {::TmpPref(chr) ::TmpPref(chg) ::TmpPref(chb)} \
            $::Pref(printColorChange) break
    foreach {::TmpPref(n1r) ::TmpPref(n1g) ::TmpPref(n1b)} \
            $::Pref(printColorNew1) break
    foreach {::TmpPref(n2r) ::TmpPref(n2g) ::TmpPref(n2b)} \
            $::Pref(printColorNew2) break

    ttk::labelframe $W.cf -text "Background Color" -padding 3

    ttk::label $W.cf.hr -text "Red"
    ttk::label $W.cf.hg -text "Green"
    ttk::label $W.cf.hb -text "Blue"

    ttk::label $W.cf.l1 -text "Change"
    MySpinBox $W.cf.s1r -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
            -width 5 -textvariable ::TmpPref(chr)
    MySpinBox $W.cf.s1g -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
            -width 5 -textvariable ::TmpPref(chg)
    MySpinBox $W.cf.s1b -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
            -width 5 -textvariable ::TmpPref(chb)
    ttk::label $W.cf.l1e -text "Example"
    addBalloon $W.cf.l1e "Screen approximation of print color"

    ttk::label $W.cf.l2 -text "Old"
    MySpinBox $W.cf.s2r -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
            -width 5 -textvariable ::TmpPref(n1r)
    MySpinBox $W.cf.s2g -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
            -width 5 -textvariable ::TmpPref(n1g)
    MySpinBox $W.cf.s2b -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
            -width 5 -textvariable ::TmpPref(n1b)
    ttk::label $W.cf.l2e -text "Example"

    ttk::label $W.cf.l3 -text "New"
    MySpinBox $W.cf.s3r -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
            -width 5 -textvariable ::TmpPref(n2r)
    MySpinBox $W.cf.s3g -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
            -width 5 -textvariable ::TmpPref(n2g)
    MySpinBox $W.cf.s3b -from 0.0 -to 1.0 -increment 0.1 -format %.1f \
            -width 5 -textvariable ::TmpPref(n2b)
    ttk::label $W.cf.l3e -text "Example"

    grid x        $W.cf.hr  $W.cf.hg  $W.cf.hb  -pady 1
    grid $W.cf.l1 $W.cf.s1r $W.cf.s1g $W.cf.s1b $W.cf.l1e -sticky w -padx 3 -pady 3
    grid $W.cf.l2 $W.cf.s2r $W.cf.s2g $W.cf.s2b $W.cf.l2e -sticky w -padx 3 -pady 3
    grid $W.cf.l3 $W.cf.s3r $W.cf.s3g $W.cf.s3b $W.cf.l3e -sticky w -padx 3 -pady 3

    trace add variable ::TmpPref write [list PrintTracePrefs $W]
    PrintTracePrefs $W

    # File
    ttk::labelframe $W.lff -text "Output File" -padding 3
    ttk::entryX $W.lff.fne -textvariable ::eskil($top,printFile) -width 30
    ttk::button $W.lff.fnb -text "Browse" \
            -command [list BrowsePrintFileName $top $W.fne]
    grid $W.lff.fne $W.lff.fnb -sticky we -padx 3 -pady 3
    grid columnconfigure $W.lff 0 -weight 1

    if {$::eskil($top,printFile) eq ""} {
        set ::eskil($top,printFile) "~/eskil.pdf"
    }

    ttk::frame $W.fb
    ttk::button $W.b1 -text "Print to File" \
            -command "destroy $W; update; PrintDiffs $top"
    ttk::button $W.b2 -text "Cancel" -command "destroy $W"
    pack $W.b1 -in $W.fb -side left  -padx {0 3} -pady 3 -ipadx 5
    pack $W.b2 -in $W.fb -side right -padx {3 0} -pady 3 -ipadx 5

    # Top Layout
    grid $W.lfs   -sticky we -padx 3 -pady 3
    grid $W.cf    -sticky we -padx 3 -pady 3
    grid $W.lff   -sticky we -padx 3 -pady 3
    grid $W.fb    -sticky swe -padx 3 -pady 3

    grid columnconfigure $W 0 -weight 1
    grid rowconfigure $W $W.fb -weight 1
}
