Version 3 of dotcanvas

Updated 2021-09-02 04:38:53 by DDG

Name

dotcanvas - canvas widget and application tied to a GraphViz dotfile with automatic updates if the file file changes.

Description

DDG 2021-09-02: dotcanvas is a special canvas widget and application with automatic rendering of a GraphViz dotfiles. If the users edits the file, the canvas widget automatically updates the display. This is nice to have a live preview of the dot file beside of your editor.

Links

Example

Below is a simple dot-file:

digraph G {
   margin=0.2;
   node[shape=box,style=filled,fillcolor=skyblue];
    A -> B;
    edge[dir=none];
    A -> C;
    edge[dir=back,color=red];
    
    C -> D;
}

You can render this dot file by using the command line:

tclsh dotcanvas.tcl  simple.dot

If you edit the dot-file in your text editor, the canvas will be automatically update, errors will be shown in the label at the bottom.

Image

Below is an image of the running application.

dotcanvas-image

Source code

Below the initial source code, the latest version should be take from the GitHub page. The code is inspired by the Wiki page File watch. Thanks for the code!

package require Tk
package provide dotcanvas 0.1

namespace eval dotcanvas {
    variable fname ""
    proc wcanvas {w file {mtime -}} {
        set checkinterval 1000 ;# modify as needed
        if {$mtime eq "-"} {
            if [info exists ::_cwf] {after cancel $::_cwf}
            set file [file join [pwd] $file]
            [namespace current]::wcanvas $w $file [file mtime $file]
        } else {
            set newtime [file mtime $file]
            if {$newtime != $mtime} {
                [namespace current]::canvasupdate $w $file
                [namespace current]::wcanvas $w $file
            } else {set ::_cwf [after $checkinterval [info level 0]]}
        }
    }
    proc canvasupdate {w file} {
        variable fname 
        puts update
        if {$fname eq ""} {
            $w delete all
            return
        }
        set dot ""
        if {$::tcl_platform(os) eq "Linux"} {
            set dot dot
        } else {
            if {[file exists "C:/Program Files/GraphViz/bin/dot.exe"]} {
                set dot "C:/Program Files/GraphViz/bin/dot.exe"
            } elseif {[file exists "C:/Programme/Graphviz/bin/dot.exe"]} {
                set dot "C:/Programme/Graphviz/bin/dot.exe"
            } 
            if {$dot eq ""} {
                tk_messageBox -title "Error!" -icon error -message "GraphViz application not found!\nInstall GraphViz!" -type ok
                return
            }
        }
        if {[catch {
             set res [exec $dot -Ttk $file]
             #puts $res
             set c $w
             $c delete all
             eval $res
             set ::einfo "File [file tail $file] is ok! [clock format [file mtime $file]]"
         }]} {
                $w configure -background salmon
                update
                after 1000
                set ::einfo [regsub {.+dot:(.+)\n +while.+} $::errorInfo "\\1"]
                $w configure -background white
        }
    }
    proc dotcanvas {path {dotfile ""}} {
        variable fname
        set fname $dotfile
        canvas $path -background white -width 200 -height 200 -borderwidth 10 -relief flat
        if {$dotfile ne ""} {
            [namespace current]::wcanvas $path $dotfile
            [namespace current]::canvasupdate $path $dotfile
        }
        return $path
    }
}
if {[info exists argv0] && $argv0 eq [info script]} {
    if {[llength $argv] > 0} {
        if {[lindex $argv 0] eq "--help"} {
            puts "dotcanvas.tcl  dotfile.dot"
        } elseif  {[lindex $argv 0] eq "--version"} {
            puts "[package present dotcanvas]"
        } elseif {[file exists [lindex $argv 0]]} {
            set ::einfo ""
            pack [dotcanvas::dotcanvas .c [lindex $argv 0]] -fill both -expand true  -padx 5 -pady 5 -ipadx 5 -ipady 5
            pack [ttk::label .l -textvariable  ::einfo] -side top -fill x -expand false -padx 5 -pady 5
        } else {
            puts "Error: File [lindex $argv 0] does not exists!"
            exit 0
        }
    } else {
       puts "dotcanvas.tcl  dotfile.dot"   
    }
}

See also


Discussion

Please discuss here ...