From: ellson Date: Sat, 12 Jan 2008 04:40:39 +0000 (+0000) Subject: -renaming demo scripts so that they consistently use . for their extent X-Git-Tag: LAST_LIBGRAPH~32^2~4871 X-Git-Url: https://granicus.if.org/sourcecode?a=commitdiff_plain;h=625453385671e2949a538ef9000d34d12dbfd011;p=graphviz -renaming demo scripts so that they consistently use . for their extent -packaging demo scripts in the appropriate graphviz- rpm -fix up php install directories --- diff --git a/tclpkg/gv/Makefile.am b/tclpkg/gv/Makefile.am index f58f85401..d1a83de48 100644 --- a/tclpkg/gv/Makefile.am +++ b/tclpkg/gv/Makefile.am @@ -294,7 +294,7 @@ DEVTSTS += test_tcl all-local: pkgIndex.tcl pkgIndex.tcl: libgv_tcl.la - sh $(top_srcdir)/tclpkg/mkpkgindex.sh libgv_tcl.la gv + sh $(top_srcdir)/tclpkg/mkpkgindex.sh libgv_tcl.la gv 0 endif endif diff --git a/tclpkg/tcldot/demo/doted b/tclpkg/tcldot/demo/doted deleted file mode 100755 index 981d21a75..000000000 --- a/tclpkg/tcldot/demo/doted +++ /dev/null @@ -1,689 +0,0 @@ -#!/bin/sh -# next line is a comment in tcl \ -exec wish "$0" ${1+"$@"} - -package require Tkspline -package require Tcldot - -# doted - dot graph editor - John Ellson (ellson@graphviz.org) -# -# Usage: doted -# -# doted displays the graph described in the input file and allows -# the user to add/delete nodes/edges, to modify their attributes, -# and to save the result. - -global saveFill tk_library modified fileName printCommand g - -# as the mouse moves over an object change its shading -proc mouse_anyenter {c} { - global tk_library saveFill - set item [string range [lindex [$c gettags current] 0] 1 end] - set saveFill [list $item [lindex [$c itemconfigure 1$item -fill] 4]] - $c itemconfigure 1$item -fill black \ - -stipple @$tk_library/demos/images/gray25.bmp -} - -# as the mouse moves out of an object restore its shading -proc mouse_anyleave {c} { - global saveFill - $c itemconfigure 1[lindex $saveFill 0] \ - -fill [lindex $saveFill 1] -stipple {} -} - -# if b1 is pressed over the brackground then start a node, -# if b1 is pressed over a node then start an edge -proc mouse_b1_press {c x y} { - global startObj graphtype - set x [$c canvasx $x] - set y [$c canvasy $y] - foreach item [$c find overlapping $x $y $x $y] { - foreach tag [$c gettags $item] { - if {[string first "node" $tag] == 1} { - set item [string range $tag 1 end] - if {[string equal $graphtype digraph]} { - set startObj [$c create line $x $y $x $y \ - -tag $item -fill red -arrow last] - } { - set startObj [$c create line $x $y $x $y \ - -tag $item -fill red] - } - return - } - } - } - set startObj [$c create oval [expr $x - 10] [expr $y - 10] \ - [expr $x + 10] [expr $y + 10] -fill red -outline black] -} - -# if node started by b1_press then move it, -# else extend edge -proc mouse_b1_motion {c x y} { - global startObj - set pos [$c coords $startObj] - if {[$c type $startObj] == "line"} { - $c coords $startObj [lindex $pos 0] [lindex $pos 1] \ - [$c canvasx $x] [$c canvasy $y] - } { - $c move $startObj [expr [$c canvasx $x] - [lindex $pos 0] - 10] \ - [expr [$c canvasy $y] - [lindex $pos 1] - 10] - } -} - -# complete node or edge construction. -proc mouse_b1_release {c x y} { - global startObj modified g - set x [$c canvasx $x] - set y [$c canvasy $y] - set t [$c type $startObj] - if {$t == "line"} { - set tail [lindex [$c gettags $startObj] 0] - foreach item [$c find overlapping $x $y $x $y] { - foreach tag [$c gettags $item] { - set head [string range $tag 1 end] - if {[string first "node" $head] == 0} { - set e [$tail addedge $head] - $c dtag $startObj $tail - $c addtag 1$e withtag $startObj - $c itemconfigure $startObj -fill black - set modified 1 - set startObj {} - return - } - } - } - # if we get here then edge isn't terminating on a node - $c delete $startObj - } { - set n [$g addnode] - $c addtag 1$n withtag $startObj - $c itemconfigure $startObj -fill white - set modified 1 - } - set startObj {} -} - -proc loadFileByName {c name} { - global modified - if {$modified} { - confirm "Current graph has been modified. Shall I overwrite it?" \ - "loadFileByNameDontAsk $c $name" - } { - loadFileByNameDontAsk $c $name - } -} - -proc loadFileByNameDontAsk {c name} { - global fileName g - $g delete - $c delete all - set modified 0 - if {[string first / $name] == 0} { - set fileName $name - } { - if {[pwd] == "/"} { - set fileName /$name - } { - set fileName [pwd]/$name - } - } - if {[catch {open $fileName r} f]} { - warning "Unable to open file: $fileName" - } - if {[catch {dotread $f} g]} { - warning "Invalid dot file: $fileName" - close $f - } - close $f - $g layout - eval [$g render] - $c configure -scrollregion [$c bbox all] -} - -proc resize_canvas {c w h} { - $c configure -scrollregion [$c bbox all] -} - -proc update_entry {w x y} { - $w.entry delete 0 end - $w.entry insert end [$w.l.list get @$x,$y] -} - -# doesn't work well with window managers that position initial window -# on the left because then all popups get obscured -# -#proc positionWindow {w} { -# set pos [split [wm geometry .] +] -# set x [expr [lindex $pos 1] - 350] -# set y [expr [lindex $pos 2] + 20] -# wm geometry $w +$x+$y -#} - -proc loadFile {c} { - global fileName - - set types { - {{DOT Graph Files} {.dot}} - {{All Files} *} - } - set fn [tk_getOpenFile \ - -defaultextension .dot \ - -filetypes $types \ - -initialfile $fileName] - if {[string length $fn]} { - loadFileByName $c $fn - } -} - -proc saveFile {type} { - global fileName - if {$fileName == {}} { - saveFileAs $type - } { - saveFileByName $fileName $type - } -} - -proc saveFileByName {name type} { - global fileName - if {$name != $fileName && [file exists $name]} { - confirm "File exists. Shall I overwrite it?" \ - "saveFileByNameDontAsk $name $type" - } { - saveFileByNameDontAsk $name $type - } -} - -proc saveFileByNameDontAsk {name type} { - global modified fileName g - if {[catch {open $name w} f]} { - warning "Unable to open file for write:\n$name; return" - } - if {$type == "dot"} { - set type canon - set fileName $name - set modified 0 - } - $g write $f $type - close $f - message "Graph written to:\n$name" -} - -proc saveFileAs {type} { - global fileName - - set cmap {{{CMAP Image Map Files} {.cmap}} {{All Files} *}} - set dia {{{DIA Image Files} {.dia}} {{All Files} *}} - set dot {{{DOT Graph Files} {.dot}} {{All Files} *}} - set fig {{{FIG Image Files} {.fig}} {{All Files} *}} - set gif {{{GIF Image Files} {.gif}} {{All Files} *}} - set hpgl {{{HPGL Image Files} {.hpgl}} {{All Files} *}} - set jpg {{{JPG Image Files} {.jpg}} {{All Files} *}} - set mif {{{MIF Image Files} {.mif}} {{All Files} *}} - set pcl {{{PCL Image Files} {.pcl}} {{All Files} *}} - set png {{{PNG Image Files} {.png}} {{All Files} *}} - set ps {{{PostScript Files} {.ps}} {{All Files} *}} - set svg {{{SVG Image Files} {.png}} {{All Files} *}} - - set fn [tk_getSaveFile \ - -defaultextension .$type \ - -filetypes [set $type] \ - -initialdir [file dirname $fileName] \ - -initialfile [file tail [file rootname $fileName]].$type] - if {[string length $fn]} { - saveFileByNameDontAsk $fn $type - } -} - -proc print {} { - global g printCommand - if {[catch {open "| $printCommand &" w} f]} { - warning "Unable to open pipe to printer command:\n$printCommand; return" - } - $g write $f ps - close $f - message "Graph printed to:\n$printCommand" -} - -proc setPrinterCommand {w} { - global printCommand - set printCommand [$w.printCommand get] - message "Printer command changed to:\n$printCommand" - destroy $w -} - -proc printSetup {} { - global printCommand - set w .printer - catch {destroy $w} - toplevel $w -# positionWindow $w - wm title $w "Printer" - wm iconname $w "Printer" - label $w.message -text "Printer command:" - frame $w.spacer -height 3m -width 20 - entry $w.printCommand - $w.printCommand insert end $printCommand - bind $w.printCommand "setPrinterCommand $w" - frame $w.buttons - button $w.buttons.confirm -text OK -command "setPrinterCommand $w" - button $w.buttons.cancel -text Cancel -command "destroy $w" - pack $w.buttons.confirm $w.buttons.cancel -side left -expand 1 - pack $w.message $w.spacer $w.printCommand -side top -anchor w - pack $w.buttons -side bottom -expand y -fill x -pady 2m -} - -proc confirm {msg cmd} { - set w .confirm - catch {destroy $w} - toplevel $w -# positionWindow $w - wm title $w "Confirm" - wm iconname $w "Confirm" - label $w.message -text "\n$msg\n" - frame $w.spacer -height 3m -width 20 - frame $w.buttons - button $w.buttons.confirm -text OK -command "$cmd; destroy $w" - button $w.buttons.cancel -text Cancel -command "destroy $w" - pack $w.buttons.confirm $w.buttons.cancel -side left -expand 1 - pack $w.message $w.spacer -side top -anchor w - pack $w.buttons -side bottom -expand y -fill x -pady 2m -} - -proc message {m} { - set w .message - catch {destroy $w} - toplevel $w -# positionWindow $w - wm title $w "Message" - wm iconname $w "Message" - label $w.message -text "\n$m\n" - pack $w.message -side top -anchor w - update - after 2000 "destroy $w" -} - -proc warning {m} { - set w .warning - catch {destroy $w} - toplevel $w -# positionWindow $w - wm title $w "Warning" - wm iconname $w "Warning" - label $w.message -text "\nWarning:\n\n$m" - pack $w.message -side top -anchor w - update - after 2000 "destroy $w" -} - -proc setoneattribute {w d a s} { - set aa [$w.e$a.a get] - if {$aa == {}} { - error "no attribute name set" - } { - set v [$w.e$a.v get] - eval $s $aa $v - } - if {$a == {}} { - destroy $w.e - addEntryPair $w $d $aa $v $s - addEntryPair $w d {} {} $s - } -} - -proc addEntryPair {w d a v s} { - pack [frame $w.e$a] -side top - pack [entry $w.e$a.a] [entry $w.e$a.v] -side left - if {$a != {}} { - $w.e$a.a insert end $a - $w.e$a.a configure -state disabled -relief flat - $w.e$a.v insert end $v - if {$d != "d"} { - $w.e$a.v configure -state disabled -relief flat - } - } - bind $w.e$a.a "focus $w.e$a.v" - bind $w.e$a.v [list setoneattribute $w $d $a $s] - pack $w.e$a -side top - focus $w.e$a.a -} - -proc deleteobj {c o} { - if {[string first "node" $o] == 0} { - foreach e [$o listedges] { - $c delete 1$e - $c delete 0$e - $e delete - } - } - $c delete 1$o - $c delete 0$o - $o delete -} - -# open a requestor for object $o, -# deletable if $d is not null, -# command to list attribute in $l -# command to query attributes in $q -# command to set attributes in $s -proc setAttributesWidget {c o d l q s} { - set w .attributes - catch {destroy $w} - toplevel $w -# positionWindow $w - wm title $w "[$o showname] Attributes" - wm iconname $w "Attributes" - foreach a [eval $l] { - if {[catch {eval $q $a} v]} {set v {}} - addEntryPair $w $d $a $v $s - } - addEntryPair $w d {} {} $s - frame $w.spacer -height 3m -width 20 - frame $w.buttons - if {$d == "d"} { - button $w.buttons.delete -text Delete -command "deleteobj $c $o; destroy $w" - pack $w.buttons.delete -side left -expand 1 - } - button $w.buttons.dismiss -text OK -command "destroy $w" - pack $w.buttons.dismiss -side left -expand 1 - pack $w.buttons -side bottom -expand y -fill x -pady 2m -} - -# open a requestor according to the type of graph object $obj, to allow the user to read and set attributions -proc setAttributes {c obj} { - global g - if {$obj == {}} { - set obj [string range [lindex [$c gettags current] 0] 1 end] - } - set type [string range $obj 0 3] - if {$type == "node" || $type == "edge"} { - if {[string length $obj] > 4} { - setAttributesWidget $c $obj d \ - "$obj listattributes" \ - "$obj queryattributes" \ - "$obj setattributes" - } { - setAttributesWidget $c $obj {} \ - "$g list[set type]attributes" \ - "$g query[set type]attributes" \ - "$g set[set type]attributes" - } - } { - setAttributesWidget $c $g {} \ - "$g listattributes" \ - "$g queryattributes" \ - "$g setattributes" - } -} - -# unconditionally remove any old graph and canvas contents, the create a new graph of $type -proc newGraphDontAsk {c type} { - global modified g graphtype - set graphtype $type - $c delete all - set modified 0 - if {[info exists g]} {$g delete} - set g [dotnew $type] -} - -# upon confirmation, remove any old graph and canvas contents, the create a new graph of $type -proc newGraph {c type} { - global modified - if {$modified} { - confirm "Current graph has been modified. Shall I continue?" \ - "newGraphDontAsk $c $type" - } { - newGraphDontAsk $c $type - } -} - -# generate a new graph layout and update rendering on the canvas -# this proc is attached to the green button to the lower right of the window -proc layout {c} { - global g - $c delete all - $g layout - eval [$g render] - $c configure -scrollregion [$c bbox all] -} - -# generate a help window with $msg as the contents -proc help {msg} { - set w .help - catch {destroy $w} - toplevel $w -# positionWindow $w - wm title $w "DotEd Help" - wm iconname $w "DotEd" - frame $w.menu -relief raised -bd 2 - pack $w.menu -side top -fill x - label $w.msg \ - -font -Adobe-helvetica-medium-r-normal--*-140-*-*-*-*-*-* \ - -wraplength 4i -justify left -text $msg - pack $w.msg -side top - frame $w.buttons - pack $w.buttons -side bottom -expand y -fill x -pady 2m - button $w.buttons.dismiss -text Dismiss -command "destroy $w" - pack $w.buttons.dismiss -side left -expand 1 -} - -# proc that supports zoom in/out events -proc zoom {c fact} { - upvar #0 $c data - set x [$c canvasx [expr {[winfo pointerx $c] - [winfo rootx $c]}]] - set y [$c canvasy [expr {[winfo pointery $c] - [winfo rooty $c]}]] - $c scale all $x $y $fact $fact - set data(zdepth) [expr {$data(zdepth) * $fact}] - after cancel $data(idle) - set data(idle) [after idle "zoomupdate $c"] -} - -# update all text strings after zom operation is complete -proc zoomupdate {c} { - upvar #0 $c data - # adjust fonts - foreach {i} [$c find all] { - if { ! [string equal [$c type $i] text]} {continue} - set fontsize 0 - # get original fontsize and text from tags - # if they were previously recorded - foreach {tag} [$c gettags $i] { - scan $tag {_f%d} fontsize - scan $tag "_t%\[^\0\]" text - } - # if not, then record current fontsize and text - # and use them - set font [$c itemcget $i -font] - if {!$fontsize} { - set text [$c itemcget $i -text] - set fontsize [lindex $font 1] - $c addtag _f$fontsize withtag $i - $c addtag _t$text withtag $i - } - # scale font - set newsize [expr {int($fontsize * $data(zdepth))}] - if {abs($newsize) >= 4} { - $c itemconfigure $i \ - -font [lreplace $font 1 1 $newsize] \ - -text $text - } { - # suppress text if too small - $c itemconfigure $i -text {} - } - } - set bbox [$c bbox all] - if {[llength $bbox]} { - $c configure -scrollregion $bbox - } { - $c configure -scrollregion [list -4 -4 \ - [expr {[winfo width $c]-4}] \ - [expr {[winfo height $c]-4}]] - } -} - -#-------------------------------------------------------------------------- -set help_about "DotEd - Dot Graph Editor -Copyright (C) 1995 AT&T Bell Labs - (C) 1996 Lucent Technologies - -Written by: John Ellson (ellson@graphviz.org) - and: Stephen North (north@research.att.com) - -DotEd provides for the graphical editing of -directed graphs. Once a graph has been manually -entered then the dot layout algorithm can be applied -by clicking on the button in the lower right corner -of the window." - -set help_mouse "Button-1: When the cursor is over the - background Button-1-Press will start a node, - Button-1-Motion (dragging the mouse with - Button-1 still down) will move it and - Button-1-Release will complete the node - insertion into the graph. - - When the cursor is over an existing node - then Button-1-Press will start an edge from - that node. Button-1-Motion will extend the - edge and Button-1-Release over a different - node will complete the edge. - -Button-2: Button-2-Motion (click and drag) will - reposition the canvas under the window. - -Button-3: When Button-3 is clicked over a - node or edge the attribute editor will - be opened on that object. - -Scrollwheel: Zooms canvas in/out. - -Once a graph has been manually entered then -the dot layout algorithm can be applied by -clicking on the button in the lower right -corner of the window." - -#-------------------------------------------------------------------------- - -#initialize some globals -set startObj {} -set saveFill {} -set modified 0 -set fileName {no_name} -set printCommand {lpr} -set zfact 1.1 - -# create main window -wm title . "DotEd" -wm iconname . "DotEd" -wm minsize . 120 100 -wm geometry . 400x300 -frame .m -relief raised -borderwidth 1 -frame .a -frame .b -set c [canvas .a.c \ - -cursor crosshair \ - -xscrollcommand ".b.h set" \ - -yscrollcommand ".a.v set" \ - -width 0 \ - -height 0 \ - -borderwidth 0] -scrollbar .b.h \ - -orient horiz \ - -relief sunken \ - -command "$c xview" -scrollbar .a.v \ - -relief sunken \ - -command "$c yview" -button .b.layout \ - -width [.a.v cget -width] \ - -height [.b.h cget -width] \ - -foreground green \ - -activeforeground green\ - -bitmap @$tk_library/demos/images/gray25.bmp \ - -command "layout $c" - -# initialize zoom state -set [set c](zdepth) 1.0 -set [set c](idle) {} - -# create graph structure and set global "g" -newGraphDontAsk $c digraph - -# canvas bindings -bind $c "resize_canvas $c %w %h" -bind $c "mouse_b1_press $c %x %y" -bind $c "mouse_b1_motion $c %x %y" -bind $c "mouse_b1_release $c %x %y" -bind $c "$c scan mark %x %y" -bind $c "$c scan dragto %x %y 1" -bind $c "setAttributes $c {}" -bind $c "zoom $c $zfact" -bind $c "zoom $c [expr {1.0/$zfact}]" - -# canvas item bindings -$c bind all "mouse_anyenter $c" -$c bind all "mouse_anyleave $c" - -menubutton .m.file -text "File" -underline 0 -menu .m.file.m -menu .m.file.m -.m.file.m add command -label "Load ..." -underline 0 \ - -command "loadFile $c" -.m.file.m add command -label "New - directed" -underline 0 \ - -command "newGraph $c digraph" -.m.file.m add command -label "New - undirected" -underline 6 \ - -command "newGraph $c graph" -.m.file.m add command -label "Save" -underline 0 \ - -command "saveFile dot" -.m.file.m add command -label "Save As ..." -underline 5 \ - -command "saveFileAs dot" -.m.file.m add separator -.m.file.m add cascade -label "Export" -underline 1 \ - -menu .m.file.m.export -menu .m.file.m.export -.m.file.m.export add command -label "CMAP ..." -underline 0 \ - -command "saveFileAs cmap" -.m.file.m.export add command -label "DIA ..." -underline 0 \ - -command "saveFileAs dia" -.m.file.m.export add command -label "FIG ..." -underline 0 \ - -command "saveFileAs fig" -.m.file.m.export add command -label "GIF ..." -underline 0 \ - -command "saveFileAs gif" -.m.file.m.export add command -label "HPGL ..." -underline 0 \ - -command "saveFileAs hpgl" -.m.file.m.export add command -label "MIF ..." -underline 0 \ - -command "saveFileAs mif" -.m.file.m.export add command -label "PNG ..." -underline 0 \ - -command "saveFileAs png" -.m.file.m.export add command -label "PS ..." -underline 0 \ - -command "saveFileAs ps" -.m.file.m.export add command -label "SVG ..." -underline 0 \ - -command "saveFileAs svg" -.m.file.m add separator -.m.file.m add command -label "Print Setup ..." -underline 0 \ - -command "printSetup" -.m.file.m add command -label "Print" -underline 0 \ - -command "print" -.m.file.m add separator -.m.file.m add command -label "Exit" -underline 0 -command "exit" -menubutton .m.graph -text "Graph" -underline 0 -menu .m.graph.m -menu .m.graph.m -.m.graph.m add command -label "Graph Attributes" -underline 0 \ - -command "setAttributes $c graph" -.m.graph.m add command -label "Node Attributes" -underline 0 \ - -command "setAttributes $c node" -.m.graph.m add command -label "Edge Attributes" -underline 0 \ - -command "setAttributes $c edge" -menubutton .m.help -text "Help" -underline 0 -menu .m.help.m -menu .m.help.m -.m.help.m add command -label "About DotEd" -underline 0 \ - -command {help $help_about} -.m.help.m add command -label "Mouse Operations" -underline 0 \ - -command {help $help_mouse} - -pack append .m .m.file {left} .m.graph {left} .m.help {right} -pack append .a $c {left expand fill} .a.v {right filly} -pack append .b .b.h {left expand fillx} .b.layout {right} -pack append . .m {top fillx} .a {expand fill} .b {bottom fillx} -tk_menuBar .m.file .m.graph .m.help - -if {$argc} {loadFileByNameDontAsk $c [lindex $argv 0]} diff --git a/tclpkg/tcldot/demo/doted.README b/tclpkg/tcldot/demo/doted.README deleted file mode 100644 index ab6366dc4..000000000 --- a/tclpkg/tcldot/demo/doted.README +++ /dev/null @@ -1,15 +0,0 @@ -doted - Graph Editor based on dot - -Author: John Ellson - -Package requires: wish, tcldot, tkspline - -A graph editor with batch layout. This script is designed to exercise -the graph layout package: tcldot - -The button in the lower-right corner triggers a relayout of the graph. - -To Do: - - complete Help feature - - add zooming - - make it easier to edit attributes diff --git a/tclpkg/tcldot/demo/gcat b/tclpkg/tcldot/demo/gcat deleted file mode 100755 index e9b43e3c7..000000000 --- a/tclpkg/tcldot/demo/gcat +++ /dev/null @@ -1,47 +0,0 @@ -#!/bin/sh -# next line is a comment in tcl \ -exec tclsh "$0" ${1+"$@"} - -package require Tcldot - -# gcat f1 [f2 ... ] -# -# merge a number of digraphs into one and output to stdout -# -# John Ellson -# - -# merge graph $g2 into $g -proc merge {g g2} { - foreach i [$g2 listnodes] { - set n [$g addnode [$i showname]] - $n setattributes [$i queryattributevalues [$i listattributes]] - } - foreach i [$g2 listedges] { - foreach {t h} [$i listnodes] {break} - set e [$g addedge [$t showname] [$h showname]] - $e setattributes [$i queryattributevalues [$i listattributes]] - } -} - -set g [dotnew digraph] -if {$argc} { - foreach file $argv { - set f [open $file r] - if {[catch {dotread $f} g2]} { - puts stderr $g2 - exit - } - merge $g $g2 - close $f - } -} { - while {![catch {dotread stdin} g2]} { - merge $g $g2 - } - if {![eof stdin]} { - puts stderr $g2 - exit - } -} -$g write stdout CANON diff --git a/tclpkg/tcldot/demo/gcat.README b/tclpkg/tcldot/demo/gcat.README deleted file mode 100644 index e7f6b63e2..000000000 --- a/tclpkg/tcldot/demo/gcat.README +++ /dev/null @@ -1,9 +0,0 @@ -gcat - simple graph filter using tcldot - -Author: John Ellson - -Package requires: tclsh, tcldot - -Usage: gcat f1 [f2 ... ] - -merge a number of digraphs into one and output to stdout