pd/src desire.tk,1.1.2.600.2.403,1.1.2.600.2.404 - Pd-cvs

20 Aug 2007


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27532
Modified Files:
      Tag: desiredata
    desire.tk 
Log Message:
new pd format parser (rewrote proc pd_mess_split)
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.403
retrieving revision 1.1.2.600.2.404
diff -C2 -d -r1.1.2.600.2.403 -r1.1.2.600.2.404
*** desire.tk	20 Aug 2007 05:25:32 -0000	1.1.2.600.2.403
--- desire.tk	20 Aug 2007 07:56:46 -0000	1.1.2.600.2.404
***************
*** 1030,1040 ****
  after 1000 pd_connect
! if {$cmdline(port)} {
    set server_port $cmdline(port)
    # and then do nothing...
! } elseif {$cmdline(valgrind)} {
    #exec valgrind --tool=memcheck $cmdline(server) -guiport $server_port &
    exec valgrind --tool=memcheck --gen-suppressions=all --suppressions=valgrind3.supp $cmdline(server) -guiport $server_port &
! } else {
      if {$cmdline(gdb)} {
    if {$cmdline(console) && $cmdline(gdbconsole)} {
--- 1030,1041 ----
  after 1000 pd_connect
! after 0 {
!   if {$cmdline(port)} {
    set server_port $cmdline(port)
    # and then do nothing...
!   } elseif {$cmdline(valgrind)} {
    #exec valgrind --tool=memcheck $cmdline(server) -guiport $server_port &
    exec valgrind --tool=memcheck --gen-suppressions=all --suppressions=valgrind3.supp $cmdline(server) -guiport $server_port &
!   } else {
      if {$cmdline(gdb)} {
    if {$cmdline(console) && $cmdline(gdbconsole)} {
***************
*** 1054,1057 ****
--- 1055,1059 ----
    exec $cmdline(server) -guiport $server_port &
      }
+   }
  }
***************
*** 5443,5451 ****
proc change_2 {self mess} {
- 	set mess [split $mess]
    set isnew [expr ![info exists ::_($self:_class)]]
    switch -- [lindex $mess 0] {
    	"#N" {if {$isnew} {Canvas new_as $self $mess} else {$self reinit $mess}}
! 		"#X" { # YOU CAN'T USE LINDEX YOU DUMMY
    		set i 1
    		# would it be possible to merge floatatom,symbolatom as gatom ?
--- 5445,5452 ----
proc change_2 {self mess} {
    set isnew [expr ![info exists ::_($self:_class)]]
    switch -- [lindex $mess 0] {
    	"#N" {if {$isnew} {Canvas new_as $self $mess} else {$self reinit $mess}}
! 		"#X" {
    		set i 1
    		# would it be possible to merge floatatom,symbolatom as gatom ?
***************
*** 5478,5482 ****
    		#post "#V: $mess"
    	}
! 		default {if {$mess != ""} {error "what you say? ($mess)"}}
    }
  }
--- 5479,5483 ----
    		#post "#V: $mess"
    	}
! 		default {if {$mess != ""} {error "what you say? «[lindex $mess 0]» in «$mess»"}}
    }
  }
***************
*** 5487,5509 ****
  #}
! # split at message boundaries.
! # \n is wiped, then that character is reused temporarily to mean a quoted semicolon.
! # BUG: this is wrong because then \; gets parsed wrong.
! proc pd_mess_split {e} {
    set r {}
! 	set m {}
! 	regsub -all "\n" $e " " y
! 	regsub -all {\;} $y "\n" z
! 	foreach mess [split $z ";"] {
! 		regsub -all "\n" $mess "\;" mess
! 		set mess [string trimleft $mess]
! 		if {$mess != ""} {lappend r $mess}
    }
    return $r
  }
! # split at atom boundaries.
! proc pd_atom_split {e} {
! 	# huh...
  }
--- 5488,5536 ----
  #}
! # split at message boundaries and atom boundaries, returning a list of lists of atoms.
! # spaces    get  temporary value \x01
! # A_SEMI    gets temporary value \x02
! # backslash gets temporary value \x03
! # A_COMMA is not handled yet
! proc pd_mess_split {s} {
! 	set s [regsub -all {\\} $s "\x03"]
! 	set s [regsub -all {(^|[^\]);}          $s "\1\x02"]
! 	set s [regsub -all {(^|[^\])[\s\n]+}    $s "\1\x01"]
! 	set s [regsub -all {^\n}                 $s "\x01"] ;# oops
! 	set s [regsub -all {(^|[^\])\([\; ])} $s "\1\2"]
! 	set s [regsub -all \x03 $s \]
    set r {}
! 	foreach m [split $s \x02] {
! 		set m [regsub -all "\x01+" $m "\x01"]
! 		set m [regsub -all "^\x01" $m ""]
! 		set t [split $m \x01]
! 		lappend r $t
    }
    return $r
  }
! proc canonical_list {list} {
! 	set r {}
! 	foreach e $list {lappend r $e}
! 	return $r
! }
! 
! proc pd_mess_split_want== {a b} {
! 	set b [canonical_list $b]
! 	set c [pd_mess_split $a]
! 	if {[string compare $c $b]} {
! 		puts "[VTred]string     «$a»\nparses to  «$c»\ninstead of «$b»[VTgrey]"
! 	} else {
! 		puts "[VTgreen]string     «$a» OK[VTgrey]"
! 	}
! }
! 
! if 0 {
! 	pd_mess_split_want== {foo;bar;baz;a;;b\;c\;;d\\;e} {foo bar baz {{a;}} {b\} {{c;}} {{d\}} e}
! 	pd_mess_split_want== {foo\ bar} {{{foo bar}}}
! 	pd_mess_split_want== {foo \  bar\ foo\ bar foo} {{foo { } {bar foo bar} foo}}
! 	pd_mess_split_want== {\ \\ \\\ \ \\ \\\ one} [list [list "\" "\\" "\\\" "\ \\ \\\ one"]]
! 	pd_mess_split_want== "\n  \n   \n  foo" foo
! 	exit
  }