util::html_diff (public)

 util::html_diff [ -old old ] [ -new new ] [ -show_old_p show_old_p ]

Defined in packages/acs-tcl/tcl/util-diff-procs.tcl

Perform a UNIX diff on 'old' and 'new', and return an HTML fragment of the changes. Requires struct::list (from tcllib)

Switches:

-old (optional)

original text

-new (optional)

new text

-show_old_p (optional, defaults to "t")

Returns:

HTML fragment of differences between 'old' and 'new'

Author:

Vinod Kurup vinod@kurup.com

Created:

2005-10-18

Partial Call Graph (max 5 caller/called nodes):

Testcases:

No testcase defined.

Source code:

    package require struct::list

    set frag $old
    set old_list [list]
    while {$frag ne ""} {
        if {![regexp "(\[^<]*)(<(/?)(\[^ \r\n\t>]+)(\[^>]*)>)?(.*)" $frag match pretag fulltag close tag tagbody frag]} {
            # should never get here since above will match anything.
            ns_log Error "util_close_html_tag - NO MATCH: should never happen! frag=$frag"
            lappend old_list $frag
            set frag {}
        }
        if {$pretag ne ""} {
            set pretag [string map {\n " "} $pretag]
            set pretag2 [list]
            foreach element [split $pretag " "] {
                if {[string trim $element] ne ""} {
                    lappend pretag2 [string trim $element]
                }
            }
            if {[llength $pretag2]} {
                lappend old_list {*}$pretag2
            }
        }
        if {$fulltag ne ""} {
            lappend old_list $fulltag
        }
    }

    set frag $new
    set new_list [list]
    while {$frag ne ""} {
        if {![regexp "(\[^<]*)(<(/?)(\[^ \r\n\t>]+)(\[^>]*)>)?(.*)" $frag match pretag fulltag close tag tagbody frag]} {
            # should never get here since above will match anything.
            lappend new_list $frag
            set frag {}
        }
        if {$pretag ne ""} {
            set pretag [string map {\n " "} $pretag]
            set pretag2 [list]
            foreach element [split $pretag " "] {
                if {[string trim $element] ne ""} {
                    lappend pretag2 [string trim $element]
                }
            }
            if {[llength $pretag2]} {
                lappend new_list {*}$pretag2
            }
        }
        if {$fulltag ne ""} {
            lappend new_list $fulltag
        }
    }
    # tcllib procs to get a list of differences between 2 lists
    # see: http://tcllib.sourceforge.net/doc/struct_list.html
    set len1 [llength $old_list]
    set len2 [llength $new_list]
    set result [::struct::list longestCommonSubsequence $old_list $new_list]
    set result [::struct::list lcsInvert $result $len1 $len2]

    # each chunk is either 'deleted', 'added', or 'changed'
    set i 0
    set last_chunk ""
    foreach chunk $result {

        set action [lindex $chunk 0]

        lassign [lindex $chunk 1] old_index1 old_index2
        lassign [lindex $chunk 2] new_index1 new_index2

        while {$i < $old_index1} {
            lappend output [lindex $old_list $i]
            incr i
        }
        if { $action eq "changed" } {
            if {$show_old_p} {
                #ns_log notice "adding <@d@>"
                lappend output <@d@>
                foreach item [lrange $old_list $old_index1 $old_index2] {
                    if {![string match "<*>" [string trim $item]]} {
                        #ns_log notice "deleting item '${item}'"
                        # showing deleted tags is a bad idea.
                        lappend output [string trim $item]
                    } else {
                        ns_log notice "SKIPPED DELETE of tag $item"
                    }

                }
                #ns_log notice "adding </@d@>"
                lappend output </@d@>
            }
            #ns_log notice "adding <@a@>"
            lappend output <@a@>
            foreach item [lrange $new_list $new_index1 $new_index2] {
                if {![string match "<*>" [string trim $item]]} {
                    #ns_log notice "adding item '${item}'"
                    lappend output [string trim $item]
                } else {
                    lappend output </@a@>${item}<@a@>
                    #ns_log notice "adding</@a@>${item}<@a@>"
                }
            }
            #ns_log notice "adding </@a@>"
            lappend output </@a@>
            incr i [expr {$old_index2 - $old_index1 + 1}]
        } elseif { $action eq "deleted" } {
            lappend output <@d@>
            foreach item [lrange $old_list $old_index1 $old_index2] {
                lappend output [string trim $item]
            }
            lappend output </@d@>
            incr i [expr {$old_index2 - $old_index1 + 1}]
        } elseif { $action eq "added" } {
            while {$i < $old_index2} {
                #ns_log notice "unchanged item"
                lappend output [lindex $old_list $i]
                incr i
            }
            lappend output <@a@>
            foreach item [lrange $new_list $new_index1 $new_index2] {
                if {![string match "<*>" [string trim $item]]} {
                    #ns_log notice "adding item"
                    lappend output [string trim $item]
                }
            }
            lappend output </@a@>
        }
    }

    # add any remaining words at the end.
    while {$i < $len1} {
        lappend output [lindex $old_list $i]
        incr i
    }

    set output [join $output " "]
    set output [string map {"<@d@>" {<span class="diff-deleted">}
        "</@d@>" </span>
        "<@a@>" {<span class="diff-added">}
        "</@a@>" </span>} $output]

    return "$output"

XQL Not present:

Generic, PostgreSQL, Oracle