diff --git a/extensions/xgui/bin/pdx.sh b/extensions/xgui/bin/pdx.sh
new file mode 100755
index 0000000000000000000000000000000000000000..0c893b65b0fe6a8c79e3caa11a20b1117188e562
--- /dev/null
+++ b/extensions/xgui/bin/pdx.sh
@@ -0,0 +1,6 @@
+#!/bin/sh
+/usr/local/bin/xgui &
+/usr/local/bin/pd -open /usr/local/lib/pdx/main/pdx_connect.pd \
+ -path /usr/local/lib/pdx/main/ \
+ -path /usr/local/lib/pdx/patch4pdx/
+
diff --git a/extensions/xgui/bin/xgui-client.sh b/extensions/xgui/bin/xgui-client.sh
new file mode 100644
index 0000000000000000000000000000000000000000..120901877e826e5f1d8c367ebb2645e96d70a779
--- /dev/null
+++ b/extensions/xgui/bin/xgui-client.sh
@@ -0,0 +1,867 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+
+#################################################
+puts "pd(x) - Step 2 : xgui-client"
+puts "xgui b0.10 dh200209xx"
+puts "Damien HENRY (c)"
+
+#################################################
+# define the globals variables needed for a node
+global xgui_gui
+global xgui_cmd_out
+global data_data
+
+global from_all
+
+global host_name
+global host_port
+global xgui_me
+set host_name localhost
+set host_port 4877
+set xgui_me "$host_name:$host_port"
+
+global pd_name
+global pd_port
+global pd_sok
+global xgui_pd
+set pd_name xxx
+set pd_port 000
+set xgui_pd "$pd_name:$pd_port"
+set pd_sok -1
+
+global neibourg_list
+global neibourg_data
+set neibourg_list [list]
+set neibourg_data [list]
+set data_data [list]
+set xgui_gui 1
+set xgui_cmd_out 0
+
+#################################################
+# Read what are the argument
+if { [lsearch argv --help] != -1 } { puts "xgui localhost 4877 -nogui -no_cmd_out" }
+
+#################################################
+# puts up my windows
+if { $xgui_gui } {
+ global text2out
+ global text_from_outside
+ global text_comment
+ wm title . "Xgui b0.09"
+ frame .haut
+ frame .config1
+ frame .config2
+ frame .bas
+ entry .haut.e_in -width 50 -textvariable text2in
+ entry .haut.e_fo -width 50 -textvariable text_from_outside -state disabled
+ entry .haut.e_rem -width 50 -textvariable text_comment -state disabled
+ entry .haut.t_out -width 50 -textvariable text2out -state disabled
+
+ entry .config1.host -width 10 -textvariable host_name
+ entry .config1.port -width 5 -textvariable host_port
+
+ entry .config2.host -width 10 -textvariable pd_name
+ entry .config2.port -width 5 -textvariable pd_port
+
+ button .config1.do -text "change" -command {
+ global xgui_me
+ global host_name
+ global host_port
+ global from_all
+ set xgui_me "$host_name:$host_port"
+ catch {close $from_all}
+ set from_all [socket -server seg_receive $host_port]
+ }
+
+ button .config2.do -text "change" -command {
+ global xgui_pd
+ global pd_name
+ global pd_port
+ set xgui_pd "$pd_name:$pd_port"
+ catch {close $pd_sok}
+ catch {set pd_sok [socket $pd_name $pd_port]}
+ }
+
+ button .bas.b_quit -text "quit" -width 7 -command {
+ send2nodes / */ "# $xgui_me disconnected"
+ do_this "$xgui_me/ ~/ disconnect *" xgui
+ exit
+ }
+ button .bas.b_do -text do -width 7 -command { do_this $text2in xgui}
+ button .bas.b_clear -text clear -width 7 -command { set text2in "" }
+
+ pack .haut.e_in .haut.e_fo .haut.t_out .haut.e_rem
+ pack .config1.host .config1.port .config1.do -side left
+ pack .config2.host .config2.port .config2.do -side left
+ pack .bas.b_do .bas.b_clear .bas.b_quit -side left -pady 2 -padx 5
+ pack .haut .config1 .config2 .bas -pady 2
+ wm resizable . false false
+}
+
+#################################################
+# definition de la partie serveur
+
+catch {set from_all [socket -server seg_receive $host_port]}
+
+proc seg_receive {channel addr port} {
+ global xgui_me
+ fileevent $channel readable "readLine $channel $addr $port"
+ do_this "/ */ # $xgui_me connected from $channel $addr $port" 0
+}
+
+proc readLine {channel addr port} {
+ global neibourg_list
+ global neibourg_data
+ global xgui_me
+ global text_from_outside
+ if {[gets $channel line]<0} {
+ fileevent $channel readable {}
+ after idle "close $channel"
+ set n [lsearch $neibourg_data $channel]
+ if {$n != -1 } {
+ set neibourg_list [lreplace $neibourg_list $n $n]
+ set neibourg_data [lreplace $neibourg_data $n $n]
+ }
+ send2nodes / */ "# $xgui_me disconnected from $addr:$port"
+ } else {
+# catch { do_this $line $channel }
+ set text_from_outside "$addr:$port $line"
+# set text_from_outside "$line"
+ do_this $line $channel
+ }
+}
+
+
+#################################################
+# tell that every thing OK
+set text_comment "$xgui_me created"
+
+# end of the initialisations
+########################################################################################
+
+#################################################
+#methods for xgui_node
+proc xgui_node_add_canvas {canvas_name} {
+ set canvas_name [string trim $canvas_name "/"]
+ set canvas_name [split $canvas_name "/"]
+ set canvas_name [lindex $canvas_name end]
+ destroy .$canvas_name
+ data_forget ~/$canvas_name
+ toplevel .$canvas_name
+ wm title .$canvas_name $canvas_name
+ wm resizable .$canvas_name false false
+ canvas .$canvas_name.$canvas_name
+ pack .$canvas_name.$canvas_name
+ data_remember ~/$canvas_name/ "~/$canvas_name add_canvas"
+ send2nodes / */ "# added ~/$canvas_name"
+
+ set c .$canvas_name.$canvas_name
+ $c bind all <Any-Enter> "itemEnter $c"
+ $c bind all <Any-Leave> "itemLeave $c"
+ bind $c <1> "itemStartDrag $c %x %y click"
+ bind $c <2> "itemStartDrag $c %x %y m-click"
+ bind $c <3> "itemStartDrag $c %x %y r_click"
+ bind $c <Shift-1> "itemStartDrag $c %x %y s-click"
+ bind $c <Shift-2> "itemStartDrag $c %x %y s-m-click"
+ bind $c <Shift-3> "itemStartDrag $c %x %y s-r-click"
+ bind $c <Control-1> "itemStartDrag $c %x %y c-click"
+ bind $c <Control-2> "itemStartDrag $c %x %y c-m-click"
+ bind $c <Control-3> "itemStartDrag $c %x %y c-r-click"
+ bind $c <B1-Motion> "itemDrag $c %x %y drag"
+ bind $c <B2-Motion> "itemDrag $c %x %y m-drag"
+ bind $c <B3-Motion> "itemDrag $c %x %y r-drag"
+ bind $c <Shift-B1-Motion> "itemDrag $c %x %y s-drag"
+ bind $c <Shift-B2-Motion> "itemDrag $c %x %y s-m-drag"
+ bind $c <Shift-B3-Motion> "itemDrag $c %x %y s-r-drag"
+ bind $c <Key> "itemKeyPress $c %A %k"
+}
+
+proc xgui_node_del_canvas {canvas_name } {
+ global text_comment
+ set canvas_name [string trim $canvas_name "/"]
+ set canvas_name [split $canvas_name "/"]
+ set canvas_name [lindex $canvas_name end]
+ destroy .$canvas_name
+ data_forget ~/$canvas_name
+ set text_comment "deleted $canvas_name"
+}
+
+proc xgui_node_error {from error} {
+ global text_comment
+ set text_comment "# error : unable to do <$error> ($from)"
+}
+
+proc xgui_node_connect { c_who c_from channel } {
+ global neibourg_list
+ global neibourg_data
+ global xgui_me
+ global text_comment
+ set c_from [string trim $c_from "/"]
+ switch $c_who {
+ "me" {
+ set n [lsearch $neibourg_data $channel]
+ if { $n == -1 } {
+ lappend neibourg_list $c_from
+ lappend neibourg_data $channel
+ set text_comment "$xgui_me connect himself to $c_from onto channel $channel"
+ } else {
+ set text_comment "$xgui_me already connected to $c_from onto channel $channel"
+ }
+ }
+ "pd" {
+ global pd_name
+ global pd_port
+ global pd_sok
+ global xgui_pd
+ set c_host [split $c_from ":"]
+ set pd_name [lindex $c_host 0]
+ set pd_port [lindex $c_host 1]
+ set xgui_pd "$pd_name:$pd_port"
+ set pd_sok [socket -async $pd_name $pd_port]
+ # set pd_sok [socket $pd_name $pd_port]
+ if { $pd_sok != -1 } {
+ set text_comment " $xgui_me connected to pd"
+ } else { set text_comment "connection refused with pd" }
+ }
+ default {
+ set c_host [split $c_who ":"]
+ set c_name [lindex $c_host 0]
+ set c_port [lindex $c_host 1]
+ set sok -1
+ catch {set sok [socket -async $c_name $c_port]}
+ if { $sok != -1 } {
+ lappend neibourg_list $c_who
+ lappend neibourg_data $sok
+ fileevent $sok readable [list read_and_do $sok]
+ set text_comment "$xgui_me connected $c_who"
+ } else { set text_comment "connection refused with $c_who" }
+ }
+ }
+}
+
+proc xgui_node_disconnect { d_who d_from channel} {
+ global neibourg_list
+ global neibourg_data
+ global text_comment
+ switch $d_who {
+ "me" {
+ set d_who [string trim $d_from "/"]
+ set n [lsearch $neibourg_list $d_who]
+ if {$n != -1 } {
+ catch { close [lrange $neibourg_data $n $n] }
+ set neibourg_list [lreplace $neibourg_list $n $n]
+ set neibourg_data [lreplace $neibourg_data $n $n]
+ set text_comment "$d_who disconnected himself"
+ } else { set text_comment "error $d_from not a neibourg" }
+ }
+
+ "pd" {
+ global pd_name
+ global pd_port
+ global pd_sok
+ global xgui_pd
+ set pd_name none
+ set pd_port none
+ set xgui_pd "$pd_name:$pd_port"
+ set pd_sok -1
+ catch {close pd_sok}
+ }
+ "*" {
+ foreach sok $neibourg_data { close $sok }
+ set neibourg_list [list]
+ set neibourg_data [list]
+ set text_comment "$d_from disconnect *"
+ }
+ default {
+ set n [lsearch $neibourg_list $d_who]
+ if {$n != -1 } {
+ catch { close [lrange $neibourg_data $n $n]
}
+ set neibourg_list [lreplace $neibourg_list $n $n]
+ set neibourg_data [lreplace $neibourg_data $n $n]
+ set text_comment "$d_who disconnected $d_from"
+ } else { set text_comment "error $d_who not a neibourg" }
+ }
+ }
+}
+
+proc xgui_node_hide { canvas } {
+ set canvas_name [string trim $canvas_name "/"]
+ set canvas_name [split $canvas_name "/"]
+ set canvas_name [lindex $canvas_name end]
+ destroy .$canvas_name
+}
+
+proc xgui_node_neibourg { w_from } {
+ global neibourg_list
+ global neibourg_data
+ global xgui_me
+ foreach name $neibourg_list {
+ send2nodes / $w_from "# $xgui_me connected to $name"
+ }
+}
+
+proc xgui_node_clone { obj new_obj } {
+ data_clone $obj $new_obj
+}
+
+proc xgui_node_load { file } {
+ data_load $file
+}
+
+proc xgui_node_save { obj file } {
+ data_save $obj $file
+}
+
+proc xgui_node_load_coord { file } {
+ data_load_send $file
+}
+
+proc xgui_node_save_coord { obj file } {
+ data_save_param $obj coord $file
+}
+
+proc xgui_node_debug { from var } {
+ global host_name
+ global host_port
+ global xgui_me
+ global neibourg_list
+ global neibourg_data
+ global xgui_gui
+ global xgui_cmd_out
+ global data_data
+ global text_comment
+ global pd_name
+ global pd_port
+ global pd_sok
+ global xgui_pd
+ global from_all
+ set text_comment "$var = [subst $var ]"
+}
+
+proc xgui_node_help { w_from } {
+ send2nodes / $w_from "# method: connect who"
+ send2nodes / $w_from "# method: disconnect who"
+ send2nodes / $w_from "# method: neibourg"
+ send2nodes / $w_from "# method: ping"
+ send2nodes / $w_from "# method: add_canvas"
+ send2nodes / $w_from "# method: del_canvas"
+}
+#################################################
+#methods for canvas
+
+proc canvas_size {canvas_name x y} {
+ .$canvas_name.$canvas_name configure -width $x
+ .$canvas_name.$canvas_name configure -height $y
+ wm geometry .$canvas_name
+ data_remember ~/$canvas_name//size "~/$canvas_name size $x $y"
+}
+
+proc canvas_color {canvas_name color} {
+ .$canvas_name.$canvas_name configure -bg $color
+ data_remember ~/$canvas_name//color "~/$canvas_name color $color"
+ }
+
+#################################################
+#methods for all objects
+
+proc obj_move {canvas gobj_name x y } {
+ global xgui_pd
+ catch {.$canvas.$canvas move $gobj_name $x $y
+ send2pd / pd/$canvas/$gobj_name "coord [.$canvas.$canvas coords $gobj_name]"
+ data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord [.$canvas.$canvas coords $gobj_name]"
+ }
+}
+
+proc obj_color {canvas gobj_name new_color} {
+ .$canvas.$canvas itemconfigure $gobj_name -fill $new_color
+ data_remember ~/$canvas/$gobj_name//color "~/$canvas/$gobj_name color $new_color"
+}
+
+proc obj_border {canvas gobj_name new_color} {
+ .$canvas.$canvas itemconfigure $gobj_name -outline $new_color
+ data_remember ~/$canvas/$gobj_name//border "~/$canvas/$gobj_name border $new_color"
+}
+
+proc obj_raise {canvas gobj_name } {
+ .$canvas.$canvas raise $gobj_name
+ data_remember ~/$canvas/$gobj_name//raise "~/$canvas/$gobj_name raise"
+}
+
+proc obj_coord {canvas gobj_name x1 y1 x2 y2 } {
+ catch {
+ .$canvas.$canvas coords $gobj_name $x1 $y1 $x2 $y2
+ data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord $x1 $y1 $x2 $y2"
+ }
+}
+
+proc obj_xy1 {canvas gobj_name x1 y1 } {
+ catch {
+ set old_coord [.$canvas.$canvas coords $gobj_name]
+ .$canvas.$canvas coords $gobj_name $x1 $y1 [lindex $old_coord 2] [lindex $old_coord 3]
+ data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord $x1 $y1 [lindex $old_coord 2] [lindex $old_coord 3]"
+ }
+}
+
+proc obj_xy2 {canvas gobj_name x2 y2 } {
+ catch {
+ set old_coord [.$canvas.$canvas coords $gobj_name]
+ .$canvas.$canvas coords $gobj_name [lindex $old_coord 0] [lindex $old_coord 1] $x2 $y2
+ data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord [lindex $old_coord 0] [lindex $old_coord 1] $x2 $y2"
+ }
+}
+
+proc obj_width {canvas gobj_name new_width} {
+ .$canvas.$canvas itemconfigure $gobj_name -width $new_width
+ data_remember ~/$canvas/$gobj_name//width "~/$canvas/$gobj_name width $new_width"
+}
+
+proc obj_near {canvas gobj_name x y} {
+ # to be done...
+}
+
+proc obj_del {canvas obj_name} {
+ .$canvas.$canvas delete $obj_name
+ send2nodes /$canvas */$canvas "# deleted $obj_name"
+ data_forget ~/$canvas/$obj_name
+}
+
+#################################################
+#methods for seg
+
+proc seg_add {canvas gobj_name x1 y1 x2 y2 } {
+ .$canvas.$canvas delete $gobj_name
+ data_forget ~/$canvas/$gobj_name
+ .$canvas.$canvas create line $x1 $y1 $x2 $y2 -width 3 -tags $gobj_name -capstyle round
+ # send2nodes /$canvas */$canvas "added $gobj_name"
+ data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_seg"
+}
+
+proc seg_caps {canvas gobj_name new_cap} {
+ .$canvas.$canvas itemconfigure $gobj_name -capstyle $new_cap
+ data_remember ~/$canvas/$gobj_name//caps "~/$canvas/$gobj_name caps $new_cap"
+}
+
+#################################################
+#methods for text
+
+proc text_add {canvas gobj_name x1 y1 text } {
+ .$canvas.$canvas delete $gobj_name
+ data_forget ~/$canvas/$gobj_name
+ .$canvas.$canvas create text $x1 $y1 -text $text -tags $gobj_name -anchor sw
+ # send2nodes /$canvas */$canvas "added $gobj_name"
+ data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_text"
+}
+
+proc text_value {canvas gobj_name value} {
+ .$canvas.$canvas itemconfigure $gobj_name -text $value
+ data_remember ~/$canvas/$gobj_name//text "~/$canvas/$gobj_name text $value"
+}
+
+proc text_anchor {canvas gobj_name value} {
+ .$canvas.$canvas itemconfigure $gobj_name -anchor $value
+ data_remember ~/$canvas/$gobj_name//anchor "~/$canvas/$gobj_name anchor $value"
+}
+
+proc text_justify {canvas gobj_name value} {
+ .$canvas.$canvas itemconfigure $gobj_name -justify $value
+ data_remember ~/$canvas/$gobj_name//justify "~/$canvas/$gobj_name justify $value"
+}
+
+proc text_pos {canvas gobj_name x y} {
+ .$canvas.$canvas coords $gobj_name $x $y
+ data_remember ~/$canvas/$gobj_name//pos "~/$canvas/$gobj_name pos $x $y"
+}
+
+#################################################
+#methods for rect
+
+proc rect_add {canvas gobj_name x1 y1 x2 y2 } {
+ .$canvas.$canvas delete $gobj_name
+ data_forget ~/$canvas/$gobj_name
+ .$canvas.$canvas create rectangle $x1 $y1 $x2 $y2 -width 2 -tags $gobj_name
+ # send2nodes /$canvas */$canvas "# added $gobj_name"
+ data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_rect"
+}
+
+#################################################
+#methods for arc
+
+proc arc_add {canvas gobj_name x1 y1 x2 y2 start width} {
+ .$canvas.$canvas delete $gobj_name
+ data_forget ~/$canvas/$gobj_name
+ .$canvas.$canvas create arc $x1 $y1 $x2 $y2 -start $start -extent $width -width 2 -tags $gobj_name
+ # send2nodes /$canvas */$canvas "# added $gobj_name "
+ data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_arc"
+}
+
+proc arc_start {canvas gobj_name new_start} {
+ .$canvas.$canvas itemconfigure $gobj_name -start $new_start
+ data_remember ~/$canvas/$gobj_name//start "~/$canvas/$gobj_name start $new_start"}
+
+proc arc_width {canvas gobj_name new_width} {
+ .$canvas.$canvas itemconfigure $gobj_name -extent $new_width
+ data_remember ~/$canvas/$gobj_name//angle "~/$canvas/$gobj_name angle $new_width"}
+
+proc arc_style {canvas gobj_name new_style} {
+ .$canvas.$canvas itemconfigure $gobj_name -style $new_style
+ data_remember ~/$canvas/$gobj_name//style "~/$canvas/$gobj_name style $new_style "}
+
+################################################
+# Set up event bindings for all canvas:
+
+proc itemStartDrag {c x y event} {
+ global xgui_pd
+ global lastX lastY
+ global my_selected
+ set lastX [$c canvasx $x]
+ set lastY [$c canvasy $y]
+ set my_selected [lindex [$c gettags current] 0]
+ set c [lindex [split $c "."] 1]
+ send2pd / pd/$c/$my_selected "$event $x $y"
+}
+
+proc itemDrag {c x y event} {
+ global xgui_pd
+ global lastX lastY
+ global my_selected
+ set x [$c canvasx $x]
+ set y [$c canvasy $y]
+ set c [lindex [split $c "."] 1]
+ send2pd / pd/$c/$my_selected "$event [expr $x-$lastX] [expr $y-$lastY]"
+ set lastX $x
+ set lastY $y
+}
+
+proc itemEnter {c} {
+ global xgui_pd
+ set my_item [lindex [$c gettags current] 0]
+ set c [lindex [split $c "."] 1]
+ send2pd / pd/$c/$my_item enter
+}
+
+proc itemLeave {c} {
+ global xgui_pd
+ set my_item [lindex [$c gettags current] 0]
+ set c [lindex [split $c "."] 1]
+ send2pd / pd/$c/$my_item leave
+}
+
+proc itemKeyPress {c ascii num} {
+ global xgui_pd
+ set my_item [lindex [$c gettags current] 0]
+ set c [lindex [split $c "."] 1]
+ send2pd / pd/$c/$my_item "keypress $ascii $num"
+ send2pd / pd/$c "keypress $ascii $num"
+}
+
+#####################################################################################
+# Here the procedures that keep a memory about all objectz.
+
+proc data_remember {obj_sel m} {
+ global data_data
+ set line_to_destroy 0
+ foreach line $data_data {
+ if {[string match "$obj_sel/*" $line] == 1} {
+ set line_to_destroy $line
+ }
+ }
+ if { $line_to_destroy !=0 } {
+ set n [lsearch $data_data $line_to_destroy ]
+ set data_data [lreplace $data_data $n $n "$obj_sel/ $m" ]
+ } else {
+ lappend data_data "$obj_sel/ $m"
+ }
+}
+
+proc data_forget { obj } {
+ global data_data
+ while { [lsearch $data_data $obj/* ] != -1} {
+ set n [lsearch $data_data $obj/* ]
+ set data_data [lreplace $data_data $n $n]
+ }
+}
+
+proc data_clone { from_obj to_new_obj } {
+ global data_data
+ foreach line $data_data {
+ if {[string match "$from_obj/*" $line] == 1} {
+ set new_line [join [lreplace [split $line] 0 0 ] ]
+ regsub -all -- $from_obj $new_line $to_new_obj newest_line
+ do_this "~/ $newest_line" 0
+ }
+ }
+}
+
+proc data_save { from_obj file } {
+ global data_data
+ set file_chn [open $file w]
+ foreach line $data_data {
+ if {[string match "$from_obj/*" $line] == 1} {
+ set new_line [join [lreplace [split $line] 0 0 ] ]
+ puts $file_chn "$new_line"
+ }
+ }
+ close $file_chn
+}
+
+proc data_save_param { from_obj selector file } {
+ global data_data
+ set file_chn [open $file w]
+ foreach line $data_data {
+ if {[string match "$from_obj/*//$selector*" $line] == 1} {
+ set new_line [join [lreplace [split $line] 0 0 ] ]
+ puts $file_chn "$new_line"
+ }
+ }
+ close $file_chn
+}
+
+proc data_load { file } {
+ global data_data
+ set file_chn [open $file r]
+ while {[eof $file_chn]==0} {
+ set line [gets $file_chn]
+ do_this "~/ $line" 0
+ }
+ close $file_chn
+}
+
+proc data_load_send { file } {
+ global data_data
+ set file_chn [open $file r]
+ while {[eof $file_chn]==0} {
+ set line [gets $file_chn]
+ set line2s [split $line]
+ set line2s [join [linsert $line2s 1 update]]
+# regsub -all -- ~/ $line2s */ new_line
+# do_this "~/ $line" 0
+ send2pd / $line2s ""
+ }
+ close $file_chn
+}
+
+
+################################################################################################
+#anything to send somewhere ???
+proc send2nodes { m_from m_to ms2send } {
+ global xgui_gui
+ global xgui_cmd_out
+ global text2out
+ global xgui_me
+ global neibourg_list
+ global neibourg_data
+
+ global text_comment
+
+ set m2send "$xgui_me$m_from $m_to $ms2send"
+ set m_to [string trim $m_to "/"]
+ set m_to_l [split $m_to "/"]
+ set m_to_node [lindex $m_to_l 0]
+
+ if { $xgui_gui == 1 } {
+ set text2out $m2send
+ }
+ if { $xgui_cmd_out == 1 } {
+ puts $m2send
+ }
+
+ switch [lindex [split $m_to "/"] 0 ] {
+ "*" {
+ foreach n $neibourg_list {
+ regsub -all -- {\*} $m_to $n m2
+ send2nodes $m_from $m2 $ms2send
+ }
+ }
+ "." {
+ foreach n $neibourg_data {
+ catch {puts $n $ms2send;flush $n}
+ }
+ }
+ default {
+ set n [lsearch $neibourg_list $m_to_node]
+ if { $n != -1 } {
+ # if catch = error then we have to remove the link.
+ catch {
+ puts [lrange $neibourg_data $n $n] "$m2send;"
+ flush [lrange $neibourg_data $n $n]
+ }
+ } else {
+ set $text_comment "didn't find any coresponding neigbourg"
+ }
+ }
+ }
+}
+
+proc send2pd { m_from m_to ms2send } {
+ global xgui_gui
+ global xgui_cmd_out
+ global text2out
+ global xgui_me
+ global pd_sok
+
+ set m2send "$xgui_me$m_from $m_to $ms2send;"
+
+ if { $xgui_gui == 1 } {
+ set text2out $m2send
+ }
+ if { $xgui_cmd_out == 1 } {
+ puts $m2send
+ }
+
+ # catch {
+ puts $pd_sok $m2send ; flush $pd_sok
+ # }
+}
+
+
+#####################################################################################
+# the 3 main proc that do every thing ##########################################
+#####################################################################################
+
+proc read_and_do { channel } {
+ gets $channel message
+ global text_from_outside
+ set text_from_outside "$channel \"$message"
+ do_this $message $channel
+}
+
+proc do_this { m channel} {
+ global xgui_me
+ set m [string trim $m ";"]
+ if {[llength $m] >= 3} {
+ set m_to [string trim [lindex $m 1] "/"]
+ set m_to_l [split $m_to "/"]
+ set m_to_node [lindex $m_to_l 0]
+ set m_from [string trim [lindex $m 0] "/"]
+ set m_cmd [lrange $m 2 end]
+ #you have to know who you are :
+ if { "$m_to_node" == "$xgui_me" } { set m_to_node "~" }
+ switch $m_to_node {
+ "~" { catch {do_this_here $m_from $m_to $m_cmd $channel}
}
+ "*" {
+ # you too are a part of the whole !!!
+ catch { do_this_here $m_from $m_to $m_cmd $channel
}
+ send2nodes / $m_to "[lrange $m 2 end]"
+ }
+ "pd" {send2pd / $m_to "[lrange $m 2 end]"}
+ default {send2nodes / $m_to "[lrange $m 2 end]"}
+ }
+ } else {
+ if {$m == "help"} {
+ # send2nodes / $m_to "# syntax : sender receiver method args..."
+ } else {
+ xgui_node_error "not enought args" $m
+ }
+ }
+}
+
+proc do_this_here { m_from m_to m_cmd channel} {
+ global xgui_me
+ global xgui_pd
+ set m_to [split $m_to "/"]
+ set m_from_l [split $m_from "/"]
+ set m_from_node [lindex $m_from_l 0]
+ set m_selector [lindex $m_cmd 0]
+ set m_argc [llength $m_cmd]-1
+ if {$m_argc >= 1} { set m_argv [lrange $m_cmd 1 end]
+ set a1 [lindex $m_argv 0]
+ if {$m_argc >=2 } { set a2 [lindex $m_argv 1]
+ if {$m_argc >=3 } { set a3 [lindex $m_argv 2]
+ if {$m_argc >=4 } { set a4 [lindex $m_argv 3]
+ if {$m_argc >=5 } { set a5 [lindex $m_argv 4]
+ if {$m_argc >=6 } { set a6 [lindex $m_argv 5]
+ if {$m_argc >=7 } { set a7 [lindex $m_argv 6]
+ if {$m_argc >=8 } { set a8 [lindex $m_argv 7]
+ if {$m_argc >=9 } { set a9 [lindex $m_argv 8]
+ if {$m_argc >=10 } { set a10 [lindex $m_argv 9]
+ } } } } } } } } }
+ } else {set m_argv "{}" }
+
+ switch [llength $m_to] {
+ 1 { # this is for the node ##########################
+ switch $m_selector {
+ "add_canvas" { xgui_node_add_canvas $a1}
+ "del_canvas" { xgui_node_del_canvas $a1}
+ "show" { xgui_node_clone $a1 $a1 }
+ "hide" { xgui_node_hide }
+ "connect" { if {$a1 == "pd"} { xgui_node_connect pd $a2 $channel
+ } else { xgui_node_connect $a1 $m_from $channel} }
+ "connect_on" { xgui_node_connect $a1 $m_from $channel
+ send2nodes / $a1/ "connect me"
+ send2nodes / $a1/ "clone ~/$a2 $xgui_me/$a2"
+ send2nodes / $a1/ "connect_on_pd $xgui_me" }
+ "connect_on_pd" { send2nodes / $a1/ "connect pd $xgui_pd" }
+ "disconnect" { xgui_node_disconnect $a1 $m_from $channel}
+
+ "neibourg" { xgui_node_neibourg $m_from }
+ "clone" { xgui_node_clone $a1 $a2 }
+ "save" { xgui_node_save $a1 $a2 }
+ "save_coord" { xgui_node_save_coord $a1 $a2 }
+ "load_coord" { xgui_node_load_coord $a1 }
+ "load" { xgui_node_load $a1 }
+ "help" { xgui_node_help $m_from }
+ "debug" { xgui_node_debug $m_from $$a1 }
+ "ping" { send2nodes / $m_from "# $m_from pinged" }
+ "#" { global text_comment ; set text_comment $m_argv}
+ default { xgui_node_error "node method $m_selector does not exist" $m_cmd }
+ }
+ }
+ 2 { # this is for the canvas $m_c ##########################
+ set m_c [lindex $m_to 1]
+ switch $m_selector {
+ "add_canvas" { catch {xgui_node_add_canvas $m_c }}
+ "del_canvas" { xgui_node_del_canvas $m_c }
+ "size" {canvas_size $m_c $a1 $a2}
+ "color" {canvas_color $m_c $a1}
+ "del" {obj_del $m_c $a1}
+ "kill" {obj_del $m_c $a1}
+ "add_seg" {seg_add $m_c $a1 10 10 20 20 }
+ "add_text" {text_add $m_c $a1 10 10 "text" }
+ "add_rect" {rect_add $m_c $a1 10 10 20 20 }
+ "add_arc" {arc_add $m_c $a1 10 10 20 20 0 90 }
+ default {xgui_node_error "canvas method $m_selector does not exist" $m_cmd }
+ }
+ }
+ 3 { # this is for the object $m_o witch is into $m_c ########
+ set m_c [lindex $m_to 1]
+ set m_o [lindex $m_to 2]
+ switch $m_selector {
+ "add_seg" {seg_add $m_c $m_o 10 10 20 20 }
+ "add_text" {text_add $m_c $m_o 10 10 "text" }
+ "add_rect" {rect_add $m_c $m_o 10 10 20 20 }
+ "add_arc" {arc_add $m_c $m_o 10 10 20 20 0 90 }
+ "del" {obj_del $m_c $m_o}
+ "kill" {obj_del $m_c $m_o}
+ "show" {obj_show $m_c $m_o }
+ "hide" {obj_hide $m_c $m_o }
+ "move" {obj_move $m_c $m_o $a1 $a2}
+ "scale" {obj_scale $m_c $m_o $a1 $a2 $a3 $a4 }
+ "raise" {obj_raise $m_c $m_o }
+ "near" {obj_near $m_c $m_o $a1 $a2 }
+ "color" {obj_color $m_c $m_o $a1}
+ "width" {obj_width $m_c $m_o $a1}
+ "coord" {obj_coord $m_c $m_o $a1 $a2 $a3 $a4 }
+ "xy1" {obj_xy1 $m_c $m_o $a1 $a2 }
+ "xy2" {obj_xy2 $m_c $m_o $a1 $a2 }
+ "border" {obj_border $m_c $m_o $a1}
+
+ "caps" {seg_caps $m_c $m_o $a1}
+
+ "text" {text_value $m_c $m_o $a1}
+ "pos" {text_pos $m_c $m_o $a1 $a2 }
+ "anchor" {text_anchor $m_c $m_o $a1}
+ "justify" {text_justify $m_c $m_o $a1}
+
+ "start" {arc_start $m_c $m_o $a1 }
+ "angle" { arc_width $m_c $m_o $a1 }
+ "style" {arc_style $m_c $m_o $a1}
+
+ default {xgui_node_error "obj_method $m_selector does not exist" $m_argv }
+ }
+ }
+ }
+}
+
diff --git a/extensions/xgui/bin/xgui.bat b/extensions/xgui/bin/xgui.bat
new file mode 100644
index 0000000000000000000000000000000000000000..4133fe0e025909f15be93ef840ac418c33ca30ba
--- /dev/null
+++ b/extensions/xgui/bin/xgui.bat
@@ -0,0 +1 @@
+..\..\bin\wish83.exe .\xgui.sh --help
diff --git a/extensions/xgui/bin/xgui.sh b/extensions/xgui/bin/xgui.sh
new file mode 100755
index 0000000000000000000000000000000000000000..da0bfcd64ed947866739fcf469e13d2e86e083ab
--- /dev/null
+++ b/extensions/xgui/bin/xgui.sh
@@ -0,0 +1,908 @@
+#!/bin/sh
+# the next line restarts using wish \
+exec wish "$0" "$@"
+
+
+#################################################
+puts "pd(x) - Step 2 : xgui"
+puts "xgui b0.10 dh200209xx"
+puts "Damien HENRY (c)"
+
+#################################################
+# define the globals variables needed for a node
+global xgui_gui
+global xgui_cmd_out
+global data_data
+
+global from_all
+
+global host_name
+global host_port
+global xgui_me
+set host_name localhost
+set host_port 4877
+set xgui_me "$host_name:$host_port"
+
+global pd_name
+global pd_port
+global pd_sok
+global xgui_pd
+set pd_name xxx
+set pd_port 000
+set xgui_pd "$pd_name:$pd_port"
+set pd_sok -1
+
+global neibourg_list
+global neibourg_data
+set neibourg_list [list]
+set neibourg_data [list]
+set data_data [list]
+set xgui_gui 1
+set xgui_cmd_out 0
+
+global time4flush
+set time4flush 20
+
+#################################################
+# Read what are the argument
+if { [lsearch argv --help] != -1 } { puts "xgui localhost 4877 -nogui -no_cmd_out" }
+
+#################################################
+# puts up my windows
+proc xgui_node_visu {onoff} {
+ set xgui_gui $onoff
+ if { $xgui_gui } {
+ global text2out
+ global text_from_outside
+ global text_comment
+ wm title . "Xgui b0.09"
+ frame .haut
+ frame .config1
+ frame .config2
+ frame .bas
+ entry .haut.e_in -width 50 -textvariable text2in
+ entry .haut.e_fo -width 50 -textvariable text_from_outside -state disabled
+ entry .haut.e_rem -width 50 -textvariable text_comment -state disabled
+ entry .haut.t_out -width 50 -textvariable text2out -state disabled
+
+ entry .config1.host -width 10 -textvariable host_name
+ entry .config1.port -width 5 -textvariable host_port
+
+ entry .config2.host -width 10 -textvariable pd_name
+ entry .config2.port -width 5 -textvariable pd_port
+
+ button .config1.do -text "change" -command {
+ global xgui_me
+ global host_name
+ global host_port
+ global from_all
+ set xgui_me "$host_name:$host_port"
+ catch {close $from_all}
+ set from_all [socket -server seg_receive $host_port]
+ }
+
+ button .config2.do -text "change" -command {
+ global xgui_pd
+ global pd_name
+ global pd_port
+ set xgui_pd "$pd_name:$pd_port"
+ catch {close $pd_sok}
+ catch {set pd_sok [socket $pd_name $pd_port]}
+ }
+
+ button .bas.b_quit -text "quit" -width 7 -command {
+ send2nodes / */ "# $xgui_me disconnected"
+ do_this "$xgui_me/ ~/ disconnect *" xgui
+ exit
+ }
+ button .bas.b_do -text do -width 7 -command { do_this $text2in xgui}
+ button .bas.b_clear -text clear -width 7 -command { set text2in "" }
+
+ pack .haut.e_in .haut.e_fo .haut.t_out .haut.e_rem
+ pack .config1.host .config1.port .config1.do -side left
+ pack .config2.host .config2.port .config2.do -side left
+ pack .bas.b_do .bas.b_clear .bas.b_quit -side left -pady 2 -padx 5
+ pack .haut .config1 .config2 .bas -pady 2
+ wm resizable . false false
+ }
+}
+
+#################################################
+# definition de la partie serveur
+#catch {
+ set from_all [socket -server seg_receive $host_port]
+#}
+
+proc seg_receive {channel addr port} {
+ global xgui_me
+ fileevent $channel readable "readLine $channel $addr $port"
+ do_this "/ */ # $xgui_me connected from $channel $addr $port" 0
+}
+
+proc readLine {channel addr port} {
+ global neibourg_list
+ global neibourg_data
+ global xgui_me
+ global text_from_outside
+ if {[gets $channel line]<0} {
+ fileevent $channel readable {}
+ after idle "close $channel"
+ set n [lsearch $neibourg_data $channel]
+ if {$n != -1 } {
+ set neibourg_list [lreplace $neibourg_list $n $n]
+ set neibourg_data [lreplace $neibourg_data $n $n]
+ }
+ send2nodes / */ "# $xgui_me disconnected from $addr:$port"
+ } else {
+ set text_from_outside "$addr:$port $line"
+ # catch {
+ do_this $line $channel
+ # }
+ }
+}
+
+
+#################################################
+# tell that every thing OK
+set text_comment "$xgui_me created"
+
+# end of the initialisations
+########################################################################################
+
+#################################################
+#methods for xgui_node
+
+proc xgui_node_name { name port } {
+ global xgui_me
+ global host_name
+ global host_port
+ global from_all
+ set host_name $name
+ set host_port $port
+ set xgui_me "$host_name:$host_port"
+ catch {close $from_all}
+ set from_all [socket -server seg_receive $host_port]
+}
+
+proc xgui_node_gui { on_off } {
+ if ( on_off == on ) {
+ }
+}
+
+proc xgui_node_add_canvas {canvas_name} {
+ set canvas_name [string trim $canvas_name "/"]
+ set canvas_name [split $canvas_name "/"]
+ set canvas_name [lindex $canvas_name end]
+ destroy .$canvas_name
+ data_forget ~/$canvas_name
+ toplevel .$canvas_name
+ wm title .$canvas_name $canvas_name
+ wm resizable .$canvas_name false false
+ canvas .$canvas_name.$canvas_name
+ pack .$canvas_name.$canvas_name
+ data_remember ~/$canvas_name/ "~/$canvas_name add_canvas"
+ send2nodes / */ "# added ~/$canvas_name"
+
+ set c .$canvas_name.$canvas_name
+ $c bind all <Any-Enter> "itemEnter $c"
+ $c bind all <Any-Leave> "itemLeave $c"
+ bind $c <1> "itemStartDrag $c %x %y click"
+ bind $c <2> "itemStartDrag $c %x %y m-click"
+ bind $c <3> "itemStartDrag $c %x %y r_click"
+ bind $c <Shift-1> "itemStartDrag $c %x %y s-click"
+ bind $c <Shift-2> "itemStartDrag $c %x %y s-m-click"
+ bind $c <Shift-3> "itemStartDrag $c %x %y s-r-click"
+ bind $c <Control-1> "itemStartDrag $c %x %y c-click"
+ bind $c <Control-2> "itemStartDrag $c %x %y c-m-click"
+ bind $c <Control-3> "itemStartDrag $c %x %y c-r-click"
+ bind $c <B1-Motion> "itemDrag $c %x %y drag"
+ bind $c <B2-Motion> "itemDrag $c %x %y m-drag"
+ bind $c <B3-Motion> "itemDrag $c %x %y r-drag"
+ bind $c <Shift-B1-Motion> "itemDrag $c %x %y s-drag"
+ bind $c <Shift-B2-Motion> "itemDrag $c %x %y s-m-drag"
+ bind $c <Shift-B3-Motion> "itemDrag $c %x %y s-r-drag"
+ bind $c <Key> "itemKeyPress $c %A %k"
+}
+
+proc xgui_node_del_canvas {canvas_name } {
+ global text_comment
+ set canvas_name [string trim $canvas_name "/"]
+ set canvas_name [split $canvas_name "/"]
+ set canvas_name [lindex $canvas_name end]
+ destroy .$canvas_name
+ data_forget ~/$canvas_name
+ set text_comment "deleted $canvas_name"
+}
+
+proc xgui_node_error {from error} {
+ global text_comment
+ set text_comment "# error : unable to do <$error> ($from)"
+}
+
+proc xgui_node_connect { c_who c_from channel } {
+ global neibourg_list
+ global neibourg_data
+ global xgui_me
+ global text_comment
+ set c_from [string trim $c_from "/"]
+ switch $c_who {
+ "me" {
+ set n [lsearch $neibourg_data $channel]
+ if { $n == -1 } {
+ lappend neibourg_list $c_from
+ lappend neibourg_data $channel
+ set text_comment "$xgui_me connect himself to $c_from onto channel $channel"
+# fconfigure $channel -blocking false -bufering line
+ } else {
+ set text_comment "$xgui_me already connected to $c_from onto channel $channel"
+ }
+ }
+ "pd" {
+ global pd_name
+ global pd_port
+ global pd_sok
+ global xgui_pd
+ set c_host [split $c_from ":"]
+ set pd_name [lindex $c_host 0]
+ set pd_port [lindex $c_host 1]
+ set xgui_pd "$pd_name:$pd_port"
+# test perf a faire....
+ set pd_sok [socket -async $pd_name $pd_port]
+# set pd_sok [socket $pd_name $pd_port]
+ if { $pd_sok != -1 } {
+ set text_comment " $xgui_me connected to pd"
+# fconfigure $pd_sok -blocking false -bufering line
+ } else { set text_comment "connection refused with pd" }
+ }
+ default {
+ set c_host [split $c_who ":"]
+ set c_name [lindex $c_host 0]
+ set c_port [lindex $c_host 1]
+ set sok -1
+ catch {set sok [socket -async $c_name $c_port]}
+ if { $sok != -1 } {
+ lappend neibourg_list $c_who
+ lappend neibourg_data $sok
+ fileevent $sok readable [list read_and_do $sok]
+# fconfigure $sok -blocking false -bufering line
+ set text_comment "$xgui_me connected $c_who"
+ } else { set text_comment "connection refused with $c_who" }
+ }
+ }
+}
+
+proc xgui_node_disconnect { d_who d_from channel} {
+ global neibourg_list
+ global neibourg_data
+ global text_comment
+ switch $d_who {
+ "me" {
+ set d_who [string trim $d_from "/"]
+ set n [lsearch $neibourg_list $d_who]
+ if {$n != -1 } {
+ catch { close [lrange $neibourg_data $n $n] }
+ set neibourg_list [lreplace $neibourg_list $n $n]
+ set neibourg_data [lreplace $neibourg_data $n $n]
+ set text_comment "$d_who disconnected himself"
+ } else { set text_comment "error $d_from not a neibourg" }
+ }
+
+ "pd" {
+ global pd_name
+ global pd_port
+ global pd_sok
+ global xgui_pd
+ set pd_name none
+ set pd_port none
+ set xgui_pd "$pd_name:$pd_port"
+ set pd_sok -1
+ catch {close pd_sok}
+ }
+ "*" {
+ foreach sok $neibourg_data { close $sok }
+ set neibourg_list [list]
+ set neibourg_data [list]
+ set text_comment "$d_from disconnect *"
+ }
+ default {
+ set n [lsearch $neibourg_list $d_who]
+ if {$n != -1 } {
+ catch { close [lrange $neibourg_data $n $n]
}
+ set neibourg_list [lreplace $neibourg_list $n $n]
+ set neibourg_data [lreplace $neibourg_data $n $n]
+ set text_comment "$d_who disconnected $d_from"
+ } else { set text_comment "error $d_who not a neibourg" }
+ }
+ }
+}
+
+proc xgui_node_hide { canvas } {
+ set canvas_name [string trim $canvas_name "/"]
+ set canvas_name [split $canvas_name "/"]
+ set canvas_name [lindex $canvas_name end]
+ destroy .$canvas_name
+}
+
+proc xgui_node_neibourg { w_from } {
+ global neibourg_list
+ global neibourg_data
+ global xgui_me
+ foreach name $neibourg_list {
+ send2nodes / $w_from "# $xgui_me connected to $name"
+ }
+}
+
+proc xgui_node_clone { obj new_obj } {
+ data_clone $obj $new_obj
+}
+
+proc xgui_node_load { file } {
+ data_load $file
+}
+
+proc xgui_node_save { obj file } {
+ data_save $obj $file
+}
+
+proc xgui_node_load_coord { file } {
+ data_load_send $file
+}
+
+proc xgui_node_save_coord { obj file } {
+ data_save_param $obj coord $file
+}
+
+proc xgui_node_debug { from var } {
+ global host_name
+ global host_port
+ global xgui_me
+ global neibourg_list
+ global neibourg_data
+ global xgui_gui
+ global xgui_cmd_out
+ global data_data
+ global text_comment
+ global pd_name
+ global pd_port
+ global pd_sok
+ global xgui_pd
+ global from_all
+ set text_comment "$var = [subst $var ]"
+}
+
+proc xgui_node_help { w_from } {
+ send2nodes / $w_from "# method: connect who"
+ send2nodes / $w_from "# method: disconnect who"
+ send2nodes / $w_from "# method: neibourg"
+ send2nodes / $w_from "# method: ping"
+ send2nodes / $w_from "# method: add_canvas"
+ send2nodes / $w_from "# method: del_canvas"
+}
+#################################################
+#methods for canvas
+
+proc canvas_size {canvas_name x y} {
+ .$canvas_name.$canvas_name configure -width $x
+ .$canvas_name.$canvas_name configure -height $y
+ wm geometry .$canvas_name
+ data_remember ~/$canvas_name//size "~/$canvas_name size $x $y"
+}
+
+proc canvas_color {canvas_name color} {
+ .$canvas_name.$canvas_name configure -bg $color
+ data_remember ~/$canvas_name//color "~/$canvas_name color $color"
+ }
+
+#################################################
+#methods for all objects
+
+proc obj_move {canvas gobj_name x y } {
+ global xgui_pd
+ catch {.$canvas.$canvas move $gobj_name $x $y
+ send2pd / pd/$canvas/$gobj_name "coord [.$canvas.$canvas coords $gobj_name]"
+ data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord [.$canvas.$canvas coords $gobj_name]"
+ }
+}
+
+proc obj_color {canvas gobj_name new_color} {
+ .$canvas.$canvas itemconfigure $gobj_name -fill $new_color
+ data_remember ~/$canvas/$gobj_name//color "~/$canvas/$gobj_name color $new_color"
+}
+
+proc obj_border {canvas gobj_name new_color} {
+ .$canvas.$canvas itemconfigure $gobj_name -outline $new_color
+ data_remember ~/$canvas/$gobj_name//border "~/$canvas/$gobj_name border $new_color"
+}
+
+proc obj_raise {canvas gobj_name } {
+ .$canvas.$canvas raise $gobj_name
+ data_remember ~/$canvas/$gobj_name//raise "~/$canvas/$gobj_name raise"
+}
+
+proc obj_coord {canvas gobj_name x1 y1 x2 y2 } {
+ catch {
+ .$canvas.$canvas coords $gobj_name $x1 $y1 $x2 $y2
+ data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord $x1 $y1 $x2 $y2"
+ }
+}
+
+proc obj_xy1 {canvas gobj_name x1 y1 } {
+ catch {
+ set old_coord [.$canvas.$canvas coords $gobj_name]
+ .$canvas.$canvas coords $gobj_name $x1 $y1 [lindex $old_coord 2] [lindex $old_coord 3]
+ data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord $x1 $y1 [lindex $old_coord 2] [lindex $old_coord 3]"
+ }
+}
+
+proc obj_xy2 {canvas gobj_name x2 y2 } {
+ catch {
+ set old_coord [.$canvas.$canvas coords $gobj_name]
+ .$canvas.$canvas coords $gobj_name [lindex $old_coord 0] [lindex $old_coord 1] $x2 $y2
+ data_remember ~/$canvas/$gobj_name//coord "~/$canvas/$gobj_name coord [lindex $old_coord 0] [lindex $old_coord 1] $x2 $y2"
+ }
+}
+
+proc obj_width {canvas gobj_name new_width} {
+ .$canvas.$canvas itemconfigure $gobj_name -width $new_width
+ data_remember ~/$canvas/$gobj_name//width "~/$canvas/$gobj_name width $new_width"
+}
+
+proc obj_near {canvas gobj_name x y} {
+ # to be done...
+}
+
+proc obj_del {canvas obj_name} {
+ .$canvas.$canvas delete $obj_name
+ send2nodes /$canvas */$canvas "# deleted $obj_name"
+ data_forget ~/$canvas/$obj_name
+}
+
+#################################################
+#methods for seg
+
+proc seg_add {canvas gobj_name x1 y1 x2 y2 } {
+ .$canvas.$canvas delete $gobj_name
+ data_forget ~/$canvas/$gobj_name
+ .$canvas.$canvas create line $x1 $y1 $x2 $y2 -width 3 -tags $gobj_name -capstyle round
+ # send2nodes /$canvas */$canvas "added $gobj_name"
+ data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_seg"
+}
+
+proc seg_caps {canvas gobj_name new_cap} {
+ .$canvas.$canvas itemconfigure $gobj_name -capstyle $new_cap
+ data_remember ~/$canvas/$gobj_name//caps "~/$canvas/$gobj_name caps $new_cap"
+}
+
+#################################################
+#methods for text
+
+proc text_add {canvas gobj_name x1 y1 text } {
+ .$canvas.$canvas delete $gobj_name
+ data_forget ~/$canvas/$gobj_name
+ .$canvas.$canvas create text $x1 $y1 -text $text -tags $gobj_name -anchor sw
+ # send2nodes /$canvas */$canvas "added $gobj_name"
+ data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_text"
+}
+
+proc text_value {canvas gobj_name value} {
+ .$canvas.$canvas itemconfigure $gobj_name -text $value
+ data_remember ~/$canvas/$gobj_name//text "~/$canvas/$gobj_name text $value"
+}
+
+proc text_anchor {canvas gobj_name value} {
+ .$canvas.$canvas itemconfigure $gobj_name -anchor $value
+ data_remember ~/$canvas/$gobj_name//anchor "~/$canvas/$gobj_name anchor $value"
+}
+
+proc text_justify {canvas gobj_name value} {
+ .$canvas.$canvas itemconfigure $gobj_name -justify $value
+ data_remember ~/$canvas/$gobj_name//justify "~/$canvas/$gobj_name justify $value"
+}
+
+proc text_pos {canvas gobj_name x y} {
+ .$canvas.$canvas coords $gobj_name $x $y
+ data_remember ~/$canvas/$gobj_name//pos "~/$canvas/$gobj_name pos $x $y"
+}
+
+#################################################
+#methods for rect
+
+proc rect_add {canvas gobj_name x1 y1 x2 y2 } {
+ .$canvas.$canvas delete $gobj_name
+ data_forget ~/$canvas/$gobj_name
+ .$canvas.$canvas create rectangle $x1 $y1 $x2 $y2 -width 2 -tags $gobj_name
+ # send2nodes /$canvas */$canvas "# added $gobj_name"
+ data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_rect"
+}
+
+#################################################
+#methods for arc
+
+proc arc_add {canvas gobj_name x1 y1 x2 y2 start width} {
+ .$canvas.$canvas delete $gobj_name
+ data_forget ~/$canvas/$gobj_name
+ .$canvas.$canvas create arc $x1 $y1 $x2 $y2 -start $start -extent $width -width 2 -tags $gobj_name
+ # send2nodes /$canvas */$canvas "# added $gobj_name "
+ data_remember ~/$canvas/$gobj_name/ "~/$canvas/$gobj_name add_arc"
+}
+
+proc arc_start {canvas gobj_name new_start} {
+ .$canvas.$canvas itemconfigure $gobj_name -start $new_start
+ data_remember ~/$canvas/$gobj_name//start "~/$canvas/$gobj_name start $new_start"}
+
+proc arc_width {canvas gobj_name new_width} {
+ .$canvas.$canvas itemconfigure $gobj_name -extent $new_width
+ data_remember ~/$canvas/$gobj_name//angle "~/$canvas/$gobj_name angle $new_width"}
+
+proc arc_style {canvas gobj_name new_style} {
+ .$canvas.$canvas itemconfigure $gobj_name -style $new_style
+ data_remember ~/$canvas/$gobj_name//style "~/$canvas/$gobj_name style $new_style "}
+
+################################################
+# Set up event bindings for all canvas:
+
+proc itemStartDrag {c x y event} {
+ global xgui_pd
+ global lastX lastY
+ global my_selected
+ set lastX [$c canvasx $x]
+ set lastY [$c canvasy $y]
+ set my_selected [lindex [$c gettags current] 0]
+ set c [lindex [split $c "."] 1]
+ send2pd / pd/$c/$my_selected "$event $x $y"
+}
+
+proc itemDrag {c x y event} {
+ global xgui_pd
+ global lastX lastY
+ global my_selected
+ set x [$c canvasx $x]
+ set y [$c canvasy $y]
+ set c [lindex [split $c "."] 1]
+ send2pd / pd/$c/$my_selected "$event [expr $x-$lastX] [expr $y-$lastY]"
+ set lastX $x
+ set lastY $y
+}
+
+proc itemEnter {c} {
+ global xgui_pd
+ set my_item [lindex [$c gettags current] 0]
+ set c [lindex [split $c "."] 1]
+ send2pd / pd/$c/$my_item enter
+}
+
+proc itemLeave {c} {
+ global xgui_pd
+ set my_item [lindex [$c gettags current] 0]
+ set c [lindex [split $c "."] 1]
+ send2pd / pd/$c/$my_item leave
+}
+
+proc itemKeyPress {c ascii num} {
+ global xgui_pd
+ set my_item [lindex [$c gettags current] 0]
+ set c [lindex [split $c "."] 1]
+ send2pd / pd/$c/$my_item "keypress $ascii $num"
+ send2pd / pd/$c "keypress $ascii $num"
+}
+
+#####################################################################################
+# Here the procedures that keep a memory about all objectz.
+
+proc data_remember {obj_sel m} {
+ global data_data
+ set line_to_destroy 0
+ foreach line $data_data {
+ if {[string match "$obj_sel/*" $line] == 1} {
+ set line_to_destroy $line
+ }
+ }
+ if { $line_to_destroy !=0 } {
+ set n [lsearch $data_data $line_to_destroy ]
+ set data_data [lreplace $data_data $n $n "$obj_sel/ $m" ]
+ } else {
+ lappend data_data "$obj_sel/ $m"
+ }
+}
+
+proc data_forget { obj } {
+ global data_data
+ while { [lsearch $data_data $obj/* ] != -1} {
+ set n [lsearch $data_data $obj/* ]
+ set data_data [lreplace $data_data $n $n]
+ }
+}
+
+proc data_clone { from_obj to_new_obj } {
+ global data_data
+ foreach line $data_data {
+ if {[string match "$from_obj/*" $line] == 1} {
+ set new_line [join [lreplace [split $line] 0 0 ] ]
+ regsub -all -- $from_obj $new_line $to_new_obj newest_line
+ do_this "~/ $newest_line" 0
+ }
+ }
+}
+
+proc data_save { from_obj file } {
+ global data_data
+ set file_chn [open $file w]
+ foreach line $data_data {
+ if {[string match "$from_obj/*" $line] == 1} {
+ set new_line [join [lreplace [split $line] 0 0 ] ]
+ puts $file_chn "$new_line"
+ }
+ }
+ close $file_chn
+}
+
+proc data_save_param { from_obj selector file } {
+ global data_data
+ set file_chn [open $file w]
+ foreach line $data_data {
+ if {[string match "$from_obj/*//$selector*" $line] == 1} {
+ set new_line [join [lreplace [split $line] 0 0 ] ]
+ puts $file_chn "$new_line"
+ }
+ }
+ close $file_chn
+}
+
+proc data_load { file } {
+ global data_data
+ set file_chn [open $file r]
+ while {[eof $file_chn]==0} {
+ set line [gets $file_chn]
+ do_this "~/ $line" 0
+ }
+ close $file_chn
+}
+
+proc data_load_send { file } {
+ global data_data
+ set file_chn [open $file r]
+ while {[eof $file_chn]==0} {
+ set line [gets $file_chn]
+ set line2s [split $line]
+ set line2s [join [linsert $line2s 1 update]]
+# regsub -all -- ~/ $line2s */ new_line
+# do_this "~/ $line" 0
+ send2pd / $line2s ""
+ }
+ close $file_chn
+}
+
+
+################################################################################################
+#anything to send somewhere ???
+proc send2nodes { m_from m_to ms2send } {
+ global xgui_gui
+ global xgui_cmd_out
+ global text2out
+ global xgui_me
+ global neibourg_list
+ global neibourg_data
+
+ global text_comment
+
+ global time4flush
+
+ set m2send "$xgui_me$m_from $m_to $ms2send"
+ set m_to [string trim $m_to "/"]
+ set m_to_l [split $m_to "/"]
+ set m_to_node [lindex $m_to_l 0]
+
+ if { $xgui_gui == 1 } {
+ set text2out $m2send
+ }
+ if { $xgui_cmd_out == 1 } {
+ puts $m2send
+ }
+
+ switch [lindex [split $m_to "/"] 0 ] {
+ "*" {
+ foreach n $neibourg_list {
+ regsub -all -- {\*} $m_to $n m2
+ send2nodes $m_from $m2 $ms2send
+ }
+ }
+ "." {
+ foreach n $neibourg_data {
+ catch {
+ puts $n $ms2send
+ #after cancel {flush $n}
+ #after $time4flush {flush $n}
+ flush $n
+ }
+ }
+ }
+ default {
+ set n [lsearch $neibourg_list $m_to_node]
+ if { $n != -1 } {
+ # if catch = error then we have to remove the link.
+ catch {
+ puts [lrange $neibourg_data $n $n] "$m2send;"
+ #after cancel {flush [lrange $neibourg_data $n $n]}
+ #after $time4flush {flush [lrange $neibourg_data $n $n]}
+ flush [lrange $neibourg_data $n $n]
+ }
+ } else {
+ set $text_comment "didn't find any coresponding neigbourg"
+ }
+ }
+ }
+}
+
+proc send2pd { m_from m_to ms2send } {
+ global xgui_gui
+ global xgui_cmd_out
+ global text2out
+ global xgui_me
+ global pd_sok
+
+ set m2send "$xgui_me$m_from $m_to $ms2send;"
+
+ if { $xgui_gui == 1 } {
+ set text2out $m2send
+ }
+ if { $xgui_cmd_out == 1 } {
+ puts $m2send
+ }
+
+ # catch {
+ puts $pd_sok $m2send
+ flush $pd_sok
+ # }
+}
+
+
+#####################################################################################
+# the 3 main proc that do every thing ##########################################
+#####################################################################################
+
+proc read_and_do { channel } {
+ gets $channel message
+ global text_from_outside
+ set text_from_outside "$channel \"$message"
+ do_this $message $channel
+}
+
+proc do_this { m channel} {
+ global xgui_me
+ set m [string trim $m ";"]
+ if {[llength $m] >= 3} {
+ set m_to [string trim [lindex $m 1] "/"]
+ set m_to_l [split $m_to "/"]
+ set m_to_node [lindex $m_to_l 0]
+ set m_from [string trim [lindex $m 0] "/"]
+ set m_cmd [lrange $m 2 end]
+ #you have to know who you are :
+ if { "$m_to_node" == "$xgui_me" } { set m_to_node "~" }
+ switch $m_to_node {
+ "~" { catch {do_this_here $m_from $m_to $m_cmd $channel}
}
+ "*" {
+ # you too are a part of the whole !!!
+ catch { do_this_here $m_from $m_to $m_cmd $channel
}
+ send2nodes / $m_to "[lrange $m 2 end]"
+ }
+ "pd" {send2pd / $m_to "[lrange $m 2 end]"}
+ default {send2nodes / $m_to "[lrange $m 2 end]"}
+ }
+ } else {
+ if {$m == "help"} {
+ # send2nodes / $m_to "# syntax : sender receiver method args..."
+ } else {
+ xgui_node_error "not enought args" $m
+ }
+ }
+}
+
+proc do_this_here { m_from m_to m_cmd channel} {
+ global xgui_me
+ global xgui_pd
+ set m_to [split $m_to "/"]
+ set m_from_l [split $m_from "/"]
+ set m_from_node [lindex $m_from_l 0]
+ set m_selector [lindex $m_cmd 0]
+ set m_argc [llength $m_cmd]-1
+ if {$m_argc >= 1} { set m_argv [lrange $m_cmd 1 end]
+ set a1 [lindex $m_argv 0]
+ if {$m_argc >=2 } { set a2 [lindex $m_argv 1]
+ if {$m_argc >=3 } { set a3 [lindex $m_argv 2]
+ if {$m_argc >=4 } { set a4 [lindex $m_argv 3]
+ if {$m_argc >=5 } { set a5 [lindex $m_argv 4]
+ if {$m_argc >=6 } { set a6 [lindex $m_argv 5]
+ if {$m_argc >=7 } { set a7 [lindex $m_argv 6]
+ if {$m_argc >=8 } { set a8 [lindex $m_argv 7]
+ if {$m_argc >=9 } { set a9 [lindex $m_argv 8]
+ if {$m_argc >=10 } { set a10 [lindex $m_argv 9]
+ } } } } } } } } }
+ } else {set m_argv "{}" }
+
+ switch [llength $m_to] {
+ 1 { # this is for the node ##########################
+ switch $m_selector {
+ "rename" { xgui_node_name $a1 $a2 }
+
+ "add_canvas" { xgui_node_add_canvas $a1}
+ "del_canvas" { xgui_node_del_canvas $a1}
+ "show" { xgui_node_clone $a1 $a1 }
+ "hide" { xgui_node_hide }
+ "connect" { if {$a1 == "pd"} { xgui_node_connect pd $a2 $channel
+ } else { xgui_node_connect $a1 $m_from $channel} }
+ "connect_on" { xgui_node_connect $a1 $m_from $channel
+ send2nodes / $a1/ "connect me"
+ send2nodes / $a1/ "clone ~/$a2 $xgui_me/$a2"
+ send2nodes / $a1/ "connect_on_pd $xgui_me" }
+ "connect_on_pd" { send2nodes / $a1/ "connect pd $xgui_pd" }
+ "disconnect" { xgui_node_disconnect $a1 $m_from $channel}
+
+ "neibourg" { xgui_node_neibourg $m_from }
+ "clone" { xgui_node_clone $a1 $a2 }
+ "save" { xgui_node_save $a1 $a2 }
+ "save_coord" { xgui_node_save_coord $a1 $a2 }
+ "load_coord" { xgui_node_load_coord $a1 }
+ "load" { xgui_node_load $a1 }
+ "help" { xgui_node_help $m_from }
+ "debug" { xgui_node_debug $m_from $$a1 }
+ "ping" { send2nodes / $m_from "# $m_from pinged" }
+ "#" { global text_comment ; set text_comment $m_argv}
+ default { xgui_node_error "node method $m_selector does not exist" $m_cmd }
+ }
+ }
+ 2 { # this is for the canvas $m_c ##########################
+ set m_c [lindex $m_to 1]
+ switch $m_selector {
+ "add_canvas" { catch {xgui_node_add_canvas $m_c }}
+ "del_canvas" { xgui_node_del_canvas $m_c }
+ "size" {canvas_size $m_c $a1 $a2}
+ "color" {canvas_color $m_c $a1}
+ "del" {obj_del $m_c $a1}
+ "kill" {obj_del $m_c $a1}
+ "add_seg" {seg_add $m_c $a1 10 10 20 20 }
+ "add_text" {text_add $m_c $a1 10 10 "text" }
+ "add_rect" {rect_add $m_c $a1 10 10 20 20 }
+ "add_arc" {arc_add $m_c $a1 10 10 20 20 0 90 }
+ default {xgui_node_error "canvas method $m_selector does not exist" $m_cmd }
+ }
+ }
+ 3 { # this is for the object $m_o witch is into $m_c ########
+ set m_c [lindex $m_to 1]
+ set m_o [lindex $m_to 2]
+ switch $m_selector {
+ "add_seg" {seg_add $m_c $m_o 10 10 20 20 }
+ "add_text" {text_add $m_c $m_o 10 10 "text" }
+ "add_rect" {rect_add $m_c $m_o 10 10 20 20 }
+ "add_arc" {arc_add $m_c $m_o 10 10 20 20 0 90 }
+ "del" {obj_del $m_c $m_o}
+ "kill" {obj_del $m_c $m_o}
+ "show" {obj_show $m_c $m_o }
+ "hide" {obj_hide $m_c $m_o }
+ "move" {obj_move $m_c $m_o $a1 $a2}
+ "scale" {obj_scale $m_c $m_o $a1 $a2 $a3 $a4 }
+ "raise" {obj_raise $m_c $m_o }
+ "near" {obj_near $m_c $m_o $a1 $a2 }
+ "color" {obj_color $m_c $m_o $a1}
+ "width" {obj_width $m_c $m_o $a1}
+ "coord" {obj_coord $m_c $m_o $a1 $a2 $a3 $a4 }
+ "xy1" {obj_xy1 $m_c $m_o $a1 $a2 }
+ "xy2" {obj_xy2 $m_c $m_o $a1 $a2 }
+ "border" {obj_border $m_c $m_o $a1}
+
+ "caps" {seg_caps $m_c $m_o $a1}
+
+ "text" {text_value $m_c $m_o $a1}
+ "pos" {text_pos $m_c $m_o $a1 $a2 }
+ "anchor" {text_anchor $m_c $m_o $a1}
+ "justify" {text_justify $m_c $m_o $a1}
+
+ "start" {arc_start $m_c $m_o $a1 }
+ "angle" { arc_width $m_c $m_o $a1 }
+ "style" {arc_style $m_c $m_o $a1}
+
+ default {xgui_node_error "obj_method $m_selector does not exist" $m_argv }
+ }
+ }
+ }
+}
+
diff --git a/externals/miXed/bin/Append-help.pd b/externals/miXed/bin/Append-help.pd
new file mode 100644
index 0000000000000000000000000000000000000000..8f50c9aeeb6b1c1b0a59b7f98b979826618773c2
--- /dev/null
+++ b/externals/miXed/bin/Append-help.pd
@@ -0,0 +1,4 @@
+#N canvas 50 50 600 400 12;
+#X text 10 10 Append clone works on messages (arrays of atoms) \, unlike the;
+#X text 10 30 internal append of Pd \, which works on data structures (lists;
+#X text 10 50 of scalars).;
diff --git a/externals/miXed/bin/Clip-help.pd b/externals/miXed/bin/Clip-help.pd
new file mode 100644
index 0000000000000000000000000000000000000000..70578ac05e1625720c1f4fe0dc8a99fa1b3a6d35
--- /dev/null
+++ b/externals/miXed/bin/Clip-help.pd
@@ -0,0 +1,3 @@
+#N canvas 50 50 600 400 12;
+#X text 10 10 Clip clone \, unlike the clip built into Pd \, handles lists;
+#X text 10 30 of floats.;
diff --git a/externals/miXed/bin/Clip~-help.pd b/externals/miXed/bin/Clip~-help.pd
new file mode 100644
index 0000000000000000000000000000000000000000..04e55a759438a57eb94f5a618bbf8725608a9517
--- /dev/null
+++ b/externals/miXed/bin/Clip~-help.pd
@@ -0,0 +1,3 @@
+#N canvas 50 50 600 400 12;
+#X text 10 10 Clip~ clone \, unlike the clip~ built into Pd \, accepts;
+#X text 10 30 signal input in range inlets for sample-accurate control.;
diff --git a/externals/miXed/bin/Line~-help.pd b/externals/miXed/bin/Line~-help.pd
new file mode 100644
index 0000000000000000000000000000000000000000..5759c13ba9e510a5ed8acd01303af2d4962f98b2
--- /dev/null
+++ b/externals/miXed/bin/Line~-help.pd
@@ -0,0 +1,10 @@
+#N canvas 50 50 600 400 12;
+#X text 10 10 Line~ clone \, unlike the line~ built into Pd;
+#X text 10 30 .;
+#X text 30 30 accepts lists of unlimited size: schedules as many;
+#X text 30 50 segments as there are pairs of floats in the input \;;
+#X text 10 70 .;
+#X text 30 70 sample-accurately starts successive segments \;;
+#X text 10 90 .;
+#X text 30 90 when last target is reached \, sends a bang through;
+#X text 30 110 the right outlet.;
diff --git a/externals/miXed/bin/Scope~-help.pd b/externals/miXed/bin/Scope~-help.pd
new file mode 100644
index 0000000000000000000000000000000000000000..2a5b28c397359c1c4e59b3075bd40dd81a397f7a
--- /dev/null
+++ b/externals/miXed/bin/Scope~-help.pd
@@ -0,0 +1,4 @@
+#N canvas 50 50 600 400 12;
+#X text 10 10 Scope~ clone's main purpose is quick \, preliminary;
+#X text 10 30 verification of other tilde clones. One can run MSP;
+#X text 10 50 patches alongside their Pd imports and watch the scope~s.;
diff --git a/externals/miXed/bin/Snapshot~-help.pd b/externals/miXed/bin/Snapshot~-help.pd
new file mode 100644
index 0000000000000000000000000000000000000000..f91d50ce388b0c9b0c6bb2db5c80d87f73adcc40
--- /dev/null
+++ b/externals/miXed/bin/Snapshot~-help.pd
@@ -0,0 +1,8 @@
+#N canvas 50 50 600 400 12;
+#X text 10 10 Snapshot~ clone \, unlike the snapshot~ built into Pd;
+#X text 10 30 .;
+#X text 30 30 optionally replaces external triggering source with an;
+#X text 30 50 internal clock \;;
+#X text 10 70 .;
+#X text 30 70 reports value of an element at a settable offset in the;
+#X text 30 90 signal vector.;
diff --git a/externals/miXed/bin/Table-help.pd b/externals/miXed/bin/Table-help.pd
new file mode 100644
index 0000000000000000000000000000000000000000..a73ea93f060a5b00e2da843cbe2a7330d792a7ed
--- /dev/null
+++ b/externals/miXed/bin/Table-help.pd
@@ -0,0 +1,11 @@
+#N canvas 50 50 600 400 12;
+#X text 10 10 Table clone's main purpose is sucking data from tables;
+#X text 10 30 embedded in Max patches.;
+#X text 10 90 Nevertheless \, most table features are supported: changing;
+#X text 10 110 size and contents \, traversal \, file i/o \, all queries;
+#X text 10 130 (including 'quantile' and 'bang') and dumping.;
+#X text 10 160 Tables with the same name share the same contents.;
+#X text 10 220 Table elements are 32-bit integers \, although some operations;
+#X text 10 240 (like embedding and editing) lose precision due to the;
+#X text 10 260 unavoidable int-to-float conversion.;
+#X text 10 290 Editing is textual \, not graphical.;
diff --git a/externals/miXed/bin/notes.txt b/externals/miXed/bin/notes.txt
new file mode 100644
index 0000000000000000000000000000000000000000..a12f918a7c1040c4e59956ed5c45a08a14941e2e
--- /dev/null
+++ b/externals/miXed/bin/notes.txt
@@ -0,0 +1,14 @@
+Keeping help files and binaries in the same directory ensures opening
+proper patches for clashing clones on crippled file systems.
+
+TODO for help files
+ * simple guide into importing
+ * describe compatibility mode
+ * detailed notes for any clone with incompatibilities
+
+DONE for help files
+
+with cyclone alpha53
+ * short notes about main differences between clashing clones (Append,
+ Clip, Clip~, Line~, Scope~, Snapshot~, Table) and the corresponding
+ internal Pd classes.
diff --git a/externals/miXed/bin/pddp/pddpboot.tcl b/externals/miXed/bin/pddp/pddpboot.tcl
new file mode 100755
index 0000000000000000000000000000000000000000..429ff8ab9604d3b58dbbb4ede5c3bbcacbc6d5ed
--- /dev/null
+++ b/externals/miXed/bin/pddp/pddpboot.tcl
@@ -0,0 +1,32 @@
+#!/bin/sh
+# \
+exec tclsh "$0" -- "$@"
+
+# Synopsis
+# test run:
+# ./pddpboot.tcl [root [port [path]]]
+# from Pd:
+# source pddpboot.tcl
+# ::pddp::srvUse root (or ::pddp::srvStart root [port])
+# ::pddp::cliOpen path
+# ... (more "::pddp::cliOpen" calls) ...
+# ::pddp::srvStop
+
+if {[namespace exists ::pddp]} { ;# created by pddplink's setup
+ puts stderr "Booting pddp"
+ set ::pddp::testrun 0
+} else {
+ puts stderr "Booting pddp, test run..."
+ namespace eval ::pddp { variable testrun 1 }
+}
+
+if {[info exists ::pddp::theDir]} {
+ source [file join $::pddp::theDir pddpclient.tcl]
+ source [file join $::pddp::theDir pddpserver.tcl]
+ if {[info exists ::pddp::theVersion]} {
+ package provide pddp $::pddp::theVersion
+ }
+} else {
+ source pddpclient.tcl]
+ source pddpserver.tcl]
+}
diff --git a/externals/miXed/bin/pddp/pddpclient.tcl b/externals/miXed/bin/pddp/pddpclient.tcl
new file mode 100644
index 0000000000000000000000000000000000000000..e16c15ca392b09e75871a65e52a54f6ac4586ad0
--- /dev/null
+++ b/externals/miXed/bin/pddp/pddpclient.tcl
@@ -0,0 +1,82 @@
+# pddpclient.tcl
+
+# Synopsis
+# not to be run by itself (see pddpboot.tcl)
+
+if {![namespace exists ::pddp]} {
+ puts stderr "Error: invalid invocation of pddpclient (boot pddp first)"
+ puts stderr "exiting..."
+ exit 1
+}
+
+if {$::pddp::testrun} { ;# true if sourced from standalone "pddpboot.tcl"
+ puts stderr "Loading pddpclient, test run..."
+ if {$argc > 3} {
+ set path [lindex $argv 3]
+ if {[string length $path]} {
+ puts stderr "Scheduling \"$path\" for opening"
+ after idle ::pddp::cliOpen $path
+ }
+ unset path
+ }
+} else {
+ puts stderr "Loading pddpclient"
+}
+
+namespace eval ::pddp {
+ variable theBrowserCommand
+
+ switch -- $::tcl_platform(platform) {
+ unix {
+ switch -- $tcl_platform(os) {
+ Darwin {
+ set theBrowserCommand "sh -c \"open %s\""
+ }
+ Linux {
+ foreach candidate \
+ {gnome-open xdg-open sensible-browser firefox mozilla galeon konqueror netscape lynx} {
+ set browser [lindex [auto_execok $candidate] 0]
+ if {[string length $browser]} {
+ set theBrowserCommand "$browser %s &"
+ break
+ }
+ }
+ }
+ }
+ }
+ windows {
+ # should not this be just: [auto_execok start]?
+ set theBrowserCommand \
+ "rundll32 url.dll,FileProtocolHandler file:%s &"
+ }
+ }
+}
+
+proc ::pddp::cliError {err} {
+ puts stderr "Error in pddpclient: $err"
+}
+
+proc ::pddp::cliOpen {path} {
+ if {[string first "://" $path] < 1} {
+ if {[info exists ::pddp::thePort]} {
+ set path "http://localhost:$::pddp::thePort/$path"
+ } else {
+ cliError "pddpserver not running"
+ return
+ }
+ }
+ variable theBrowserCommand
+ if {[string length $theBrowserCommand]} {
+ set command [format $theBrowserCommand $path]
+ puts stderr "pddpclient: exec $command"
+ if {[catch {eval [list exec] $command} err]} {
+ if {[lindex $::errorCode 0] eq "CHILDSTATUS"} {
+ cliError "$err (child status [lindex $::errorCode 2])"
+ } else {
+ cliError $err
+ }
+ }
+ } else {
+ cliError "browser unavailable"
+ }
+}
diff --git a/externals/miXed/bin/pddp/pddpserver.tcl b/externals/miXed/bin/pddp/pddpserver.tcl
new file mode 100644
index 0000000000000000000000000000000000000000..f4a94448a6351b98ca9fdc0436c77f6f769a1f7b
--- /dev/null
+++ b/externals/miXed/bin/pddp/pddpserver.tcl
@@ -0,0 +1,507 @@
+# pddpserver.tcl
+
+# Synopsis
+# not to be run by itself (see pddpboot.tcl)
+
+# based on:
+
+# Simple Sample httpd/1.[01] server
+# Stephen Uhler (c) 1996-1997 Sun Microsystems
+
+# http://cvs.sourceforge.net/viewcvs.py/tclhttpd/tclhttpd/bin/mini/mini1.1.tcl
+
+# modified by krzYszcz (2005):
+# putting per-server data and all commands in a namespace "::pddp"
+# supporting sourcing from within Pd, through the "pddpboot.tcl" wrapper
+# inserting the .pd handler
+# lots of other changes, too many to list here (run "diff" if curious...)
+
+if {![namespace exists ::pddp]} {
+ puts stderr "Error: invalid invocation of pddpserver (boot pddp first)"
+ puts stderr "exiting..."
+ exit 1
+}
+
+if {$::pddp::testrun} { ;# true if sourced from standalone "pddpboot.tcl"
+ puts stderr "Loading pddpserver, test run..."
+ proc bgerror {msg} {
+ global errorInfo
+ puts stderr "bgerror: $msg\n$errorInfo"
+ }
+} else {
+ puts stderr "Loading pddpserver"
+# catch {console show}
+}
+
+namespace eval ::pddp {
+ variable thePort 0
+ variable theState
+ variable theMimeTypes
+ variable theErrors
+ variable theErrorFormat
+
+ # "theState" contains the server state:
+ # root: the root of the document directory
+ # default: default document name
+ # listen: the main listening socket id
+ # naccepts: a count of accepted connections so far
+ # maxtime: the max time (msec) allowed to complete an http request
+ # maxused: the max # of requests for a socket
+ array set theState {
+ root ""
+ default index.html
+ listen ""
+ naccepts 0
+ nrequests 0
+ nerrors 0
+ maxtime 600000
+ maxused 25
+ bufsize 32768
+ }
+
+ set theState(root) $env(HOME)
+
+ array set theMimeTypes {
+ {} text/plain
+ .txt text/plain
+ .html text/html
+ .gif image/gif
+ .jpg image/jpeg
+ .pd text/html
+ }
+
+ # HTTP/1.[01] error codes (the ones we use)
+ array set theErrors {
+ 204 {No Content}
+ 400 {Bad Request}
+ 404 {Not Found}
+ 405 {Method Not Allowed}
+ 408 {Request Timeout}
+ 411 {Length Required}
+ 419 {Expectation Failed}
+ 500 {Internal Server Error}
+ 503 {Service Unavailable}
+ 504 {Service Temporarily Unavailable}
+ 505 {HTTP Version Not Supported}
+ }
+
+ # Generic error response
+ set theErrorFormat {
+ <title>Error: %1$s</title>
+ Got the error: <b>%2$s</b><br>
+ while trying to obtain <b>%3$s</b>
+ }
+}
+
+proc ::pddp::srvUse {{root {}} {port 0}} {
+ variable theState
+ if {[string length $theState(listen)]} {
+ if {[string length $root] && ![string equal $root $theState(root)]} {
+ srvLog $theState(listen) Warning "Redirection attempt for $root"
+ }
+ } else {
+ srvStart $root $port
+ }
+}
+
+# Start the server by listening for connections on the desired port.
+
+proc ::pddp::srvStart {{root {}} {port 0}} {
+ variable thePort
+ variable theState
+
+ puts stderr "Starting pddp server on [info hostname]"
+ if {[string length $root]} {
+ set theState(root) $root
+ }
+ # we do not handle multiple pddpservers, LATER rethink
+ srvStop
+ array set theState [list naccepts 0 nrequests 0 nerrors 0]
+
+ for { set thePort $port } {$thePort < 65535 } {incr thePort } {
+ if {[catch {set theState(listen) \
+ [socket -server ::pddp::srvAccept $thePort]} res]} {
+ if {$thePort == 0} {
+ # FIXME this is a critical error
+ set thePort 32768
+ }
+ } else { break }
+ }
+ if {$thePort == 65535} {
+ srvLog none Error "Could not find port available for listening"
+ } else {
+ if {$thePort == 0} {
+ set thePort [lindex [fconfigure $theState(listen) -sockname] 2]
+ }
+ srvLog $theState(listen) Port $thePort
+ srvLog $theState(listen) Root directory \"$root\"
+ }
+ after 120 update ;# FIXME might be needed on windows they say, test there
+ return $thePort
+}
+
+proc ::pddp::srvStop {} {
+ variable thePort
+ variable theState
+ if {[string length $theState(listen)]} {
+ if {[catch {close $theState(listen)} res]} {
+ srvLog $theState(listen) Warning [list $res while closing socket]
+ } else {
+ srvLog $theState(listen) Closed.
+ }
+ set theState(listen) ""
+ update
+ }
+}
+
+# Accept a new connection from the server and set up a handler
+# to read the request from the client.
+
+proc ::pddp::srvAccept {sock ipaddr port} {
+ variable theState
+ variable theSockData$sock
+ # reject remote requests, LATER revisit
+ if {[string equal $ipaddr "127.0.0.1"]} {
+ incr theState(naccepts)
+ srvReset $sock $theState(maxused)
+ srvLog $sock Connect $ipaddr $port
+ } else {
+ srvLog $sock Warning "rejecting remote connection request from $ipaddr"
+ srvSockDone $sock 1
+ }
+}
+
+# Initialize or reset the socket state
+
+proc ::pddp::srvReset {sock nlft} {
+ variable theState
+ upvar 0 ::pddp::theSockData$sock sockData
+ array set sockData [list state start linemode 1 version 0 nleft $nlft]
+ set sockData(cancel) \
+ [after $theState(maxtime) [list srvTimeout $sock]]
+ fconfigure $sock -blocking 0 -buffersize $theState(bufsize) \
+ -translation {auto crlf}
+ fileevent $sock readable [list ::pddp::srvRead $sock]
+}
+
+# Read data from a client request
+# 1) read the request line
+# 2) read the mime headers
+# 3) read the additional data (if post && content-length not satisfied)
+
+proc ::pddp::srvRead {sock} {
+ variable theState
+ upvar 0 ::pddp::theSockData$sock sockData
+
+ # Use line mode to read the request and the mime headers
+
+ if {$sockData(linemode)} {
+ set readCount [gets $sock line]
+ set state [string compare $readCount 0],$sockData(state)
+ switch -glob -- $state {
+ 1,start {
+ if {[regexp {(HEAD|POST|GET) ([^?]+)\??([^ ]*) HTTP/1.([01])} \
+ $line x sockData(proto) sockData(url) \
+ sockData(query) sockData(version)]} {
+ set sockData(state) mime
+ incr theState(nrequests)
+ srvLog $sock Request $sockData(nleft) $line
+ } else {
+ srvError $sock 400 $line
+ }
+ }
+ 0,start {
+ srvLog $sock Warning "Initial blank line fetching request"
+ }
+ 1,mime {
+ if {[regexp {([^:]+):[ ]*(.*)} $line {} key value]} {
+ set key [string tolower $key]
+ set sockData(key) $key
+ if {[info exists sockData(mime,$key)]} {
+ append sockData(mime,$key) ", $value"
+ } else {
+ set sockData(mime,$key) $value
+ }
+ } elseif {[regexp {^[ ]+(.+)} $line {} value] && \
+ [info exists sockData(key)]} {
+ append sockData(mime,$sockData($key)) " " $value
+ } else {
+ srvError $sock 400 $line
+ }
+ }
+ 0,mime {
+ if {$sockData(proto) == "POST" && \
+ [info exists sockData(mime,content-length)]} {
+ set sockData(linemode) 0
+ set sockData(count) $sockData(mime,content-length)
+ if {$sockData(version) && \
+ [info exists sockData(mime,expect)]} {
+ if {$sockData(mime,expect) == "100-continue"} {
+ puts $sock "100 Continue HTTP/1.1\n"
+ flush $sock
+ } else {
+ srvError $sock 419 $sockData(mime,expect)
+ }
+ }
+ fconfigure $sock -translation {binary crlf}
+ } elseif {$sockData(proto) != "POST"} {
+ srvRespond $sock
+ } else {
+ srvError $sock 411 "Confusing mime headers"
+ }
+ }
+ -1,* {
+ if {[eof $sock]} {
+ srvLog $sock Error "Broken connection fetching request"
+ srvSockDone $sock 1
+ } else {
+ puts stderr "Partial read, retrying"
+ }
+ }
+ default {
+ srvError $sock 404 "Invalid http state: $state,[eof $sock]"
+ }
+ }
+
+ # Use counted mode to get the post data
+
+ } elseif {![eof $sock]} {
+ append sockData(postdata) [read $sock $sockData(count)]
+ set sockData(count) [expr {$sockData(mime,content-length) - \
+ [string length $sockData(postdata)]}]
+ if {$sockData(count) == 0} {
+ srvRespond $sock
+ }
+ } else {
+ srvLog $sock Error "Broken connection reading POST data"
+ srvSockDone $sock 1
+ }
+}
+
+# Done with the socket, either close it, or set up for next fetch
+# sock: The socket I'm done with
+# doclose: If true, close the socket, otherwise set up for reuse
+
+proc ::pddp::srvSockDone {sock doclose} {
+ variable theState
+ upvar 0 ::pddp::theSockData$sock sockData
+
+ after cancel $sockData(cancel)
+ set nleft [incr sockData(nleft) -1]
+ unset sockData
+ if {$doclose} {
+ close $sock
+ } else {
+ srvReset $sock $nleft
+ }
+ return ""
+}
+
+# A timeout happened
+
+proc ::pddp::srvTimeout {sock} {
+ srvError $sock 408
+}
+
+proc ::pddp::srvPdOpen {path} {
+ global menu_windowlist
+ set name [file tail $path]
+ set dir [file dirname $path]
+ # FIXME white space in $name and $dir
+ # FIXME this is a fragile hack, there should be an "openx" message to pd...
+ foreach en $menu_windowlist {
+ set wd [lindex $en 1]
+ set nm [lindex $en 0]
+ set dr [lindex [wm title $wd] end]
+ if {[string equal $name $nm] && [string equal $dir $dr]} {
+ # FIXME test on windows
+ raise $wd
+ focus -force $wd
+ return
+ }
+ }
+ pd [concat pd open $name $dir \;]
+ # FIXME raise and focus on windows?
+}
+
+proc ::pddp::srvPdHandler {sock path} {
+ if {[catch {::pddp::srvPdOpen $path}]} {
+ srvError $sock 504
+ } else {
+ srvError $sock 204
+ }
+}
+
+# Handle file system queries. This is a place holder for a more
+# generic dispatch mechanism.
+
+proc ::pddp::srvRespond {sock} {
+ variable theState
+ variable theUrlCache
+ upvar 0 ::pddp::theSockData$sock sockData
+
+ regsub {(^http://[^/]+)?} $sockData(url) {} url
+ if {[info exists theUrlCache($url)]} {
+ set mypath $theUrlCache($url)
+ } else {
+ set mypath [srvUrl2File $theState(root) $url]
+ if {[file isdirectory $mypath]} {
+ append mypath / $theState(default)
+ }
+ set theUrlCache($url) $mypath
+ }
+ if {[string length $mypath] == 0} {
+ srvError $sock 400
+ } elseif {![file readable $mypath]} {
+ if {[string equal [file tail $mypath] "favicon.ico"]} {
+ srvError $sock 204 ;# FIXME design something
+ } else {
+ srvError $sock 404 $mypath
+ }
+ } else {
+ set ext [file extension $mypath]
+
+ if {[string equal $ext ".pd"]} {
+ srvPdHandler $sock $mypath
+ return
+ }
+
+ puts $sock "HTTP/1.$sockData(version) 200 Data follows"
+ puts $sock "Date: [srvGetDate [clock seconds]]"
+ puts $sock "Last-Modified: [srvGetDate [file mtime $mypath]]"
+ puts $sock "Content-Type: [srvContentType $ext]"
+ puts $sock "Content-Length: [file size $mypath]"
+
+ ## Should also close socket if recvd connection close header
+ set doclose [expr {$sockData(nleft) == 0}]
+
+ if {$doclose} {
+ puts $sock "Connection close:"
+ } elseif {$sockData(version) == 0 && \
+ [info exists sockData(mime,connection)]} {
+ if {$sockData(mime,connection) == "Keep-Alive"} {
+ set doclose 0
+ puts $sock "Connection: Keep-Alive"
+ }
+ }
+ puts $sock ""
+ flush $sock
+
+ if {$sockData(proto) != "HEAD"} {
+ set in [open $mypath]
+ fconfigure $sock -translation binary
+ fconfigure $in -translation binary
+ fcopy $in $sock -command \
+ [list ::pddp::srvCopyDone $in $sock $doclose]
+ } else {
+ srvSockDone $sock $doclose
+ }
+ }
+}
+
+# Callback when file is done being output to client
+# in: The fd for the file being copied
+# sock: The client socket
+# doclose: close the socket if true
+# bytes: The # of bytes copied
+# error: The error message (if any)
+
+proc ::pddp::srvCopyDone {in sock doclose bytes {error {}}} {
+ close $in
+ srvLog $sock Done $bytes bytes
+ srvSockDone $sock $doclose
+}
+
+# Convert the file suffix into a mime type.
+
+proc ::pddp::srvContentType {ext} {
+ variable theMimeTypes
+ set type text/plain
+ catch {set type $theMimeTypes($ext)}
+ return $type
+}
+
+# Respond with an error reply
+# sock: The socket handle to the client
+# code: The httpd error code
+# args: Additional information for error logging
+
+proc ::pddp::srvError {sock code args} {
+ variable theState
+ variable theErrors
+ variable theErrorFormat
+ upvar 0 ::pddp::theSockData$sock sockData
+
+ append sockData(url) ""
+ incr theState(nerrors)
+ set message [format $theErrorFormat $code $theErrors($code) $sockData(url)]
+ append head "HTTP/1.$sockData(version) $code $theErrors($code)" \n
+ append head "Date: [srvGetDate [clock seconds]]" \n
+ append head "Connection: close" \n
+ append head "Content-Length: [string length $message]" \n
+
+ # Because there is an error condition, the socket may be "dead"
+
+ catch {
+ fconfigure $sock -translation crlf
+ puts -nonewline $sock $head\n$message
+ flush $sock
+ } reason
+ srvSockDone $sock 1
+ if {$code < 300} {set status Status} else {set status Error}
+ srvLog $sock $status $code $theErrors($code) $args $reason
+}
+
+# Generate a date string in HTTP format.
+
+proc ::pddp::srvGetDate {seconds} {
+ return [clock format $seconds -format {%a, %d %b %Y %T %Z}]
+}
+
+# Log an Httpd transaction.
+# This should be replaced as needed.
+
+proc ::pddp::srvLog {sock args} {
+ puts stderr "pddp log ($sock): $args"
+}
+
+# Convert a url into a pathname. (UNIX version only)
+# This is probably not right, and belongs somewhere else.
+# - Remove leading http://... if any
+# - Collapse all /./ and /../ constructs
+# - expand %xx sequences -> disallow "/"'s and "."'s due to expansions
+
+proc ::pddp::srvUrl2File {root url} {
+ regsub -all {//+} $url / url ;# collapse multiple /'s
+ while {[regsub -all {/\./} $url / url]} {} ;# collapse /./
+ while {[regsub -all {/\.\.(/|$)} $url /\x81\\1 url]} {} ;# mark /../
+ while {[regsub "/\[^/\x81]+/\x81/" $url / url]} {} ;# collapse /../
+ if {![regexp "\x81|%2\[eEfF]" $url]} { ;# invalid /../, / or . ?
+ return $root[srvCgiMap $url]
+ } else {
+ return ""
+ }
+}
+
+# Decode url-encoded strings.
+
+proc ::pddp::srvCgiMap {data} {
+ regsub -all {([][$\\])} $data {\\\1} data
+ regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data {[format %c 0x\1]} data
+ return [subst $data]
+}
+
+if {$::pddp::testrun} { ;# true if tested as a standalone script
+ if {$argc > 1} {
+ set root [lindex $argv 1]
+ set port [lindex $argv 2]
+ if {![string is integer -strict $port]} {
+ set port 32768
+ }
+ } else {
+ set root $env(HOME)
+ set port 32768
+ }
+ ::pddp::srvStart $root $port
+ vwait forever
+}
diff --git a/externals/miXed/bin/pddp/pkgIndex.tcl b/externals/miXed/bin/pddp/pkgIndex.tcl
new file mode 100644
index 0000000000000000000000000000000000000000..10b89a62efb0bd0a04842b7fdb847b15fcbcc80e
--- /dev/null
+++ b/externals/miXed/bin/pddp/pkgIndex.tcl
@@ -0,0 +1,10 @@
+proc LoadPddp { version dir } {
+ namespace eval ::pddp {}
+ set ::pddp::theVersion $version
+ set ::pddp::theDir $dir
+ source [file join $dir pddpboot.tcl]
+}
+
+set version "0.1.0.3"
+
+package ifneeded pddp $version [list LoadPddp $version $dir]
diff --git a/externals/pdp/bin/patchversion b/externals/pdp/bin/patchversion
new file mode 100644
index 0000000000000000000000000000000000000000..1976db44cbd2f7e8f699061f13f6fff2242a9153
--- /dev/null
+++ b/externals/pdp/bin/patchversion
@@ -0,0 +1,9 @@
+#!/bin/bash
+
+# cat <<EOF | cat
+cat <<EOF | ed -s configure.ac
+,s/PDP_VERSION=.*/PDP_VERSION=$1/
+,wq
+EOF
+
+
diff --git a/externals/pdp/bin/pdp-config b/externals/pdp/bin/pdp-config
new file mode 100644
index 0000000000000000000000000000000000000000..0be670f9d4c85483af72266628e203ee858323b7
--- /dev/null
+++ b/externals/pdp/bin/pdp-config
@@ -0,0 +1,39 @@
+#!/bin/sh
+
+prefix=/usr/local
+version=0.12.7-svn
+
+usage="\
+Usage: pdp-config [--version] [--cflags] [--libdir]"
+
+if test $# -eq 0; then
+ echo "${usage}" 1>&2
+ exit 1
+fi
+
+while test $# -gt 0; do
+ case "$1" in
+ -*=*) optarg=`echo "$1" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) optarg= ;;
+ esac
+
+ case $1 in
+ -n)
+ NEWLINE="-n"
+ ;;
+ --libdir)
+ echo $NEWLINE $prefix/lib/scaf
+ ;;
+ --version)
+ echo $NEWLINE $version
+ ;;
+ --cflags)
+ echo $NEWLINE -I$prefix/include/pdp
+ ;;
+ *)
+ echo "${usage}" 1>&2
+ exit 1
+ ;;
+ esac
+ shift
+done
diff --git a/externals/pdp/bin/pdp-config.in b/externals/pdp/bin/pdp-config.in
new file mode 100755
index 0000000000000000000000000000000000000000..2f3855daf33bc30dca1805de14b52af4096b90b8
--- /dev/null
+++ b/externals/pdp/bin/pdp-config.in
@@ -0,0 +1,39 @@
+#!/bin/sh
+
+prefix=@prefix@
+version=@PDP_VERSION@
+
+usage="\
+Usage: pdp-config [--version] [--cflags] [--libdir]"
+
+if test $# -eq 0; then
+ echo "${usage}" 1>&2
+ exit 1
+fi
+
+while test $# -gt 0; do
+ case "$1" in
+ -*=*) optarg=`echo "$1" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) optarg= ;;
+ esac
+
+ case $1 in
+ -n)
+ NEWLINE="-n"
+ ;;
+ --libdir)
+ echo $NEWLINE $prefix/lib/scaf
+ ;;
+ --version)
+ echo $NEWLINE $version
+ ;;
+ --cflags)
+ echo $NEWLINE -I$prefix/include/pdp
+ ;;
+ *)
+ echo "${usage}" 1>&2
+ exit 1
+ ;;
+ esac
+ shift
+done
diff --git a/externals/pdp/bin/predist b/externals/pdp/bin/predist
new file mode 100644
index 0000000000000000000000000000000000000000..dfe644697cd32719a520490ecd9391b9ce79cfd1
--- /dev/null
+++ b/externals/pdp/bin/predist
@@ -0,0 +1,6 @@
+
+# patch version if environment variable is set
+[ -z $PDP_DIST_VERSION ] || sh bin/patchversion $PDP_DIST_VERSION
+
+# run autoconf with (patched) configure.ac
+sh bootstrap
diff --git a/externals/pdp/bin/release-version b/externals/pdp/bin/release-version
new file mode 100755
index 0000000000000000000000000000000000000000..841b826bbe00af784cf25df08b32d4cf2be73654
--- /dev/null
+++ b/externals/pdp/bin/release-version
@@ -0,0 +1 @@
+cat configure.ac |grep PDP_VERSION= | sed s/PDP_VERSION=// | sed s/-darcs//
diff --git a/externals/pdp/bin/snapshot b/externals/pdp/bin/snapshot
new file mode 100644
index 0000000000000000000000000000000000000000..ea93e51ef2538ae619dc76022707d470ccce8721
--- /dev/null
+++ b/externals/pdp/bin/snapshot
@@ -0,0 +1,10 @@
+[ "$1" == "-d" ] && shift && APPEND="-`date +%Y%m%d_%H%M%S`"
+[ -z "$1" ] && echo "usage $0 [-d] <name>" && exit 1
+
+VER="$1$APPEND"
+
+# for autoconf patch in bin/predist
+export PDP_DIST_VERSION=$VER
+
+# create archive
+exec darcs dist -d "pdp-$VER"